procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'trunk' into xwidget

Browse source
This commit is contained in:
Joakim Verona 2013-07-20 01:44:36 +02:00
commit 759dbb1aeb
101 changed files with 2732 additions and 1666 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
doc/lispref/ChangeLog
View file

@ -1,3 +1,12 @@
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
`set-frame-selected-window''s arguments.
2013-07-10 Paul Eggert <eggert@cs.ucla.edu>
Timestamp fixes for undo (Bug#14824).

11
doc/lispref/windows.texi
View file

@ -1355,10 +1355,9 @@ within that frame. @var{frame} should be a live frame; if omitted or
@defun set-frame-selected-window frame window &optional norecord
This function makes @var{window} the window selected within the frame
@var{frame}. @var{frame} should be a live frame; if omitted or
@code{nil}, it defaults to the selected frame. @var{window} should be
a live window; if omitted or @code{nil}, it defaults to the selected
window.
@var{frame}. @var{frame} should be a live frame; if @code{nil}, it
defaults to the selected frame. @var{window} should be a live window;
if @code{nil}, it defaults to the selected window.
If @var{frame} is the selected frame, this makes @var{window} the
selected window.
@ -1925,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

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
* NEWS: Document blink-cursor-blinks and blink timers stopped.
2013-07-13 Eli Zaretskii <eliz@gnu.org>
* NEWS: Document prefer-utf-8 and the new attributes

21
etc/NEWS
View file

@ -122,6 +122,11 @@ monitor, use the new functions above. Similar notes also apply to
Generic commands are interactive functions whose implementation can be
selected among several alternatives, as a matter of user preference.
** The blink cursor stops blinking after 10 blinks (default) on X and NS.
You can change the default by customizing the variable blink-cursor-blinks.
Also timers for blinking are stopped when no blinking is done, so Emacs does
not consume CPU cycles.
* Editing Changes in Emacs 24.4
@ -255,8 +260,10 @@ on the given date.
*** `desktop-auto-save-timeout' defines the number of seconds between
auto-saves of the desktop.
*** `desktop-restore-frames' enables saving and restoring the window/frame
configuration.
*** `desktop-restore-frames', enabled by default, allows saving and
restoring the window/frame configuration. Additional options
`desktop-restore-in-current-display' and
`desktop-restoring-reuses-frames' allow further customization.
** Dired
@ -454,6 +461,13 @@ module.
*** The Info-edit command is obsolete. Editing Info nodes by hand
has not been relevant for some time.
** Shell
*** `explicit-bash-args' now always defaults to use --noediting.
During initialization, Emacs no longer expends a process to decide
whether it is safe to use Bash's --noediting option. These days
--noediting is ubiquitous; it was introduced in 1996 in Bash version 2.
* New Modes and Packages in Emacs 24.4
@ -547,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'.

119
lisp/ChangeLog
View file

@ -1,3 +1,118 @@
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): 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.
(auto-revert-notify-add-watch): Use `file-notify-supported-p'.
* net/tramp.el (tramp-file-name-for-operation):
Add `file-notify-supported-p'.
* net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
New defun.
(tramp-sh-file-name-handler-alist): Add it as handler for
`file-notify-supported-p '.
* net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* net/tramp-smb.el (tramp-smb-file-name-handler-alist):
Add `ignore' as handler for `file-notify-*' functions.
2013-07-17 Eli Zaretskii <eliz@gnu.org>
* simple.el (line-move-partial, line-move): Don't start vscroll or
scroll-up if the current line is not taller than the window.
(Bug#14881)
2013-07-16 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-font-lock-keywords): Do not
highlight question marks in the method names as strings.
(ruby-block-beg-keywords): Inline.
(ruby-font-lock-keyword-beg-re): Extract from
`ruby-font-lock-keywords'.
2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
* frame.el (blink-cursor-blinks): New defcustom.
(blink-cursor-blinks-done): New defvar.
(blink-cursor-start): Set blink-cursor-blinks-done to 1.
(blink-cursor-timer-function): Check if number of blinks has been
done on X and NS.
(blink-cursor-suspend, blink-cursor-check): New defuns.
2013-07-15 Glenn Morris <rgm@gnu.org>
* edmacro.el (edmacro-format-keys): Fix previous change.
2013-07-15 Paul Eggert <eggert@cs.ucla.edu>
* shell.el (explicit-bash-args): Remove obsolete hack for Bash 1.x.
The hack didn't work outside English locales anyway.
2013-07-15 Juanma Barranquero <lekktu@gmail.com>
* simple.el (define-alternatives): Rename from alternatives-define,
per RMS' suggestion.
2013-07-14 Juanma Barranquero <lekktu@gmail.com>
* desktop.el (desktop-restore-frames): Change default to t.
(desktop-restore-in-current-display): Now offer more options.
(desktop-restoring-reuses-frames): New customization option.
(desktop--saved-states): Doc fix.
(desktop-filter-parameters-alist): New variable, renamed and expanded
from desktop--excluded-frame-parameters.
(desktop--target-display): New variable.
(desktop-switch-to-gui-p, desktop-switch-to-tty-p)
(desktop--filter-tty*, desktop--filter-*-color)
(desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
(desktop--filter-save-desktop-parm)
(desktop-restore-in-original-display-p): New functions.
(desktop--filter-frame-parms): Use new desktop-filter-parameters-alist.
(desktop--save-minibuffer-frames): New function, inspired by a similar
function from Martin Rudalics.
(desktop--save-frames): Call it; play nice with desktop-globals-to-save.
(desktop--restore-in-this-display-p): Remove.
(desktop--find-frame): Rename from desktop--find-frame-in-display
and add predicate argument.
(desktop--make-full-frame): Remove, integrated into desktop--make-frame.
(desktop--reuse-list): New variable.
(desktop--select-frame, desktop--make-frame, desktop--sort-states):
New functions.
(desktop--restore-frames): Add support for "minibuffer-special" frames.
2013-07-14 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-sh.el (tramp-sh-handle-vc-registered): Use `ignore-error'.
2013-07-13 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight
@ -3475,8 +3590,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.

22
lisp/autorevert.el
View file

@ -271,21 +271,20 @@ This variable becomes buffer local when set in any fashion.")
:type 'boolean
:version "24.4")
(defcustom auto-revert-use-notify (and file-notify-support t)
(defcustom auto-revert-use-notify
;; We use the support of the local filesystem as default.
(file-notify-supported-p temporary-file-directory)
"If non-nil Auto Revert Mode uses file notification functions.
This requires Emacs being compiled with file notification
support (see `file-notify-support'). You should set this variable
through Custom."
You should set this variable through Custom."
:group 'auto-revert
:type 'boolean
:set (lambda (variable value)
(set-default variable (and file-notify-support value))
(set-default variable value)
(unless (symbol-value variable)
(when file-notify-support
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (symbol-value 'auto-revert-notify-watch-descriptor)
(auto-revert-notify-rm-watch)))))))
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (symbol-value 'auto-revert-notify-watch-descriptor)
(auto-revert-notify-rm-watch))))))
:initialize 'custom-initialize-default
:version "24.4")
@ -513,7 +512,8 @@ will use an up-to-date value of `auto-revert-interval'"
(set (make-local-variable 'auto-revert-use-notify) nil))
(when (and buffer-file-name auto-revert-use-notify
(not auto-revert-notify-watch-descriptor))
(not auto-revert-notify-watch-descriptor)
(file-notify-supported-p buffer-file-name))
(setq auto-revert-notify-watch-descriptor
(ignore-errors
(file-notify-add-watch

2
lisp/cedet/semantic/bovine/el.el
View file

@ -474,7 +474,7 @@ Return a bovination list to use."
((and name (file-exists-p (concat name ".el.gz")))
;; This is the linux distro case.
(concat name ".el.gz"))
;; source file does not exists
;; Source file does not exist.
(name
(message "semantic: cannot find source file %s" (concat name ".el")))
(t

501
lisp/desktop.el
View file

@ -33,6 +33,7 @@
;; - the mark & mark-active
;; - buffer-read-only
;; - some local variables
;; - frame and window configuration
;; To use this, use customize to turn on desktop-save-mode or add the
;; following line somewhere in your init file:
@ -127,7 +128,6 @@
;; ---------------------------------------------------------------------------
;; TODO:
;;
;; Save window configuration.
;; Recognize more minor modes.
;; Save mark rings.
@ -369,16 +369,29 @@ modes are restored automatically; they should not be listed here."
:type '(repeat symbol)
:group 'desktop)
(defcustom desktop-restore-frames nil
(defcustom desktop-restore-frames t
"When non-nil, save window/frame configuration to desktop file."
:type 'boolean
:group 'desktop
:version "24.4")
(defcustom desktop-restore-in-current-display nil
"When non-nil, frames are restored in the current display.
Otherwise they are restored, if possible, in their original displays."
:type 'boolean
"If t, frames are restored in the current display.
If nil, frames are restored, if possible, in their original displays.
If `delete', frames on other displays are deleted instead of restored."
:type '(choice (const :tag "Restore in current display" t)
(const :tag "Restore in original display" nil)
(const :tag "Delete frames in other displays" 'delete))
:group 'desktop
:version "24.4")
(defcustom desktop-restoring-reuses-frames t
"If t, restoring frames reuses existing frames.
If nil, existing frames are deleted.
If `keep', existing frames are kept and not reused."
:type '(choice (const :tag "Reuse existing frames" t)
(const :tag "Delete existing frames" nil)
(const :tag "Keep existing frames" 'keep))
:group 'desktop
:version "24.4")
@ -566,7 +579,7 @@ DIRNAME omitted or nil means use `desktop-dirname'."
Used to avoid writing contents unchanged between auto-saves.")
(defvar desktop--saved-states nil
"Internal use only.")
"Saved window/frame state. Internal use only.")
;; ----------------------------------------------------------------------------
;; Desktop file conflict detection
@ -869,30 +882,193 @@ DIRNAME must be the directory in which the desktop file will be saved."
;; ----------------------------------------------------------------------------
(defconst desktop--excluded-frame-parameters
'(buffer-list
buffer-predicate
buried-buffer-list
explicit-name
font
font-backend
minibuffer
name
outer-window-id
parent-id
window-id
window-system)
"Frame parameters not saved or restored.")
(defvar desktop-filter-parameters-alist
'((background-color . desktop--filter-*-color)
(buffer-list . t)
(buffer-predicate . t)
(buried-buffer-list . t)
(desktop-font . desktop--filter-restore-desktop-parm)
(desktop-fullscreen . desktop--filter-restore-desktop-parm)
(desktop-height . desktop--filter-restore-desktop-parm)
(desktop-width . desktop--filter-restore-desktop-parm)
(font . desktop--filter-save-desktop-parm)
(font-backend . t)
(foreground-color . desktop--filter-*-color)
(fullscreen . desktop--filter-save-desktop-parm)
(height . desktop--filter-save-desktop-parm)
(minibuffer . desktop--filter-minibuffer)
(name . t)
(outer-window-id . t)
(parent-id . t)
(tty . desktop--filter-tty*)
(tty-type . desktop--filter-tty*)
(width . desktop--filter-save-desktop-parm)
(window-id . t)
(window-system . t))
"Alist of frame parameters and filtering functions.
(defun desktop--filter-frame-parms (frame)
"Return frame parameters of FRAME.
Parameters in `desktop--excluded-frame-parameters' are excluded.
Each element is a cons (PARAM . FILTER), where PARAM is a parameter
name (a symbol identifying a frame parameter), and FILTER can be t
\(meaning the parameter is removed from the parameter list on saving
and restoring), or a function that will be called with three args:
CURRENT a cons (PARAM . VALUE), where PARAM is the one being
filtered and VALUE is its current value
PARAMETERS the complete alist of parameters being filtered
SAVING non-nil if filtering before saving state, nil otherwise
The FILTER function must return:
nil CURRENT is removed from the list
t CURRENT is left as is
(PARAM' . VALUE') replace CURRENT with this
Frame parameters not on this list are passed intact.")
(defvar desktop--target-display nil
"Either (minibuffer . VALUE) or nil.
This refers to the current frame config being processed inside
`frame--restore-frames' and its auxiliary functions (like filtering).
If nil, there is no need to change the display.
If non-nil, display parameter to use when creating the frame.
Internal use only.")
(defun desktop-switch-to-gui-p (parameters)
"True when switching to a graphic display.
Return t if PARAMETERS describes a text-only terminal and
the target is a graphic display; otherwise return nil.
Only meaningful when called from a filtering function in
`desktop-filter-parameters-alist'."
(and desktop--target-display ; we're switching
(null (cdr (assq 'display parameters))) ; from a tty
(cdr desktop--target-display))) ; to a GUI display
(defun desktop-switch-to-tty-p (parameters)
"True when switching to a text-only terminal.
Return t if PARAMETERS describes a graphic display and
the target is a text-only terminal; otherwise return nil.
Only meaningful when called from a filtering function in
`desktop-filter-parameters-alist'."
(and desktop--target-display ; we're switching
(cdr (assq 'display parameters)) ; from a GUI display
(null (cdr desktop--target-display)))) ; to a tty
(defun desktop--filter-tty* (_current parameters saving)
;; Remove tty and tty-type parameters when switching
;; to a GUI frame.
(or saving
(not (desktop-switch-to-gui-p parameters))))
(defun desktop--filter-*-color (current parameters saving)
;; Remove (foreground|background)-color parameters
;; when switching to a GUI frame if they denote an
;; "unspecified" color.
(or saving
(not (desktop-switch-to-gui-p parameters))
(not (stringp (cdr current)))
(not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
(defun desktop--filter-minibuffer (current _parameters saving)
;; When minibuffer is a window, save it as minibuffer . t
(or (not saving)
(if (windowp (cdr current))
'(minibuffer . t)
t)))
(defun desktop--filter-restore-desktop-parm (current parameters saving)
;; When switching to a GUI frame, convert desktop-XXX parameter to XXX
(or saving
(not (desktop-switch-to-gui-p parameters))
(let ((val (cdr current)))
(if (eq val :desktop-processed)
nil
(cons (intern (substring (symbol-name (car current))
8)) ;; (length "desktop-")
val)))))
(defun desktop--filter-save-desktop-parm (current parameters saving)
;; When switching to a tty frame, save parameter XXX as desktop-XXX so it
;; can be restored in a subsequent GUI session, unless it already exists.
(cond (saving t)
((desktop-switch-to-tty-p parameters)
(let ((sym (intern (format "desktop-%s" (car current)))))
(if (assq sym parameters)
nil
(cons sym (cdr current)))))
((desktop-switch-to-gui-p parameters)
(let* ((dtp (assq (intern (format "desktop-%s" (car current)))
parameters))
(val (cdr dtp)))
(if (eq val :desktop-processed)
nil
(setcdr dtp :desktop-processed)
(cons (car current) val))))
(t t)))
(defun desktop-restore-in-original-display-p ()
"True if saved frames' displays should be honored."
(cond ((daemonp) t)
((eq system-type 'windows-nt) nil)
(t (null desktop-restore-in-current-display))))
(defun desktop--filter-frame-parms (parameters saving)
"Filter frame parameters and return filtered list.
PARAMETERS is a parameter alist as returned by `frame-parameters'.
If SAVING is non-nil, filtering is happening before saving frame state;
otherwise, filtering is being done before restoring frame state.
Parameters are filtered according to the setting of
`desktop-filter-parameters-alist' (which see).
Internal use only."
(let (params)
(dolist (param (frame-parameters frame))
(unless (memq (car param) desktop--excluded-frame-parameters)
(push param params)))
params))
(let ((filtered nil))
(dolist (param parameters)
(let ((filter (cdr (assq (car param) desktop-filter-parameters-alist)))
this)
(cond (;; no filter: pass param
(null filter)
(push param filtered))
(;; filter = t; skip param
(eq filter t))
(;; filter func returns nil: skip param
(null (setq this (funcall filter param parameters saving))))
(;; filter func returns t: pass param
(eq this t)
(push param filtered))
(;; filter func returns a new param: use it
t
(push this filtered)))))
;; Set the display parameter after filtering, so that filter functions
;; have access to its original value.
(when desktop--target-display
(let ((display (assq 'display filtered)))
(if display
(setcdr display (cdr desktop--target-display))
(push desktop--target-display filtered))))
filtered))
(defun desktop--save-minibuffer-frames ()
;; Adds a desktop-mini parameter to frames
;; desktop-mini is a list (MINIBUFFER NUMBER DEFAULT?) where
;; MINIBUFFER t if the frame (including minibuffer-only) owns a minibuffer
;; NUMBER if MINIBUFFER = t, an ID for the frame; if nil, the ID of
;; the frame containing the minibuffer used by this frame
;; DEFAULT? if t, this frame is the value of default-minibuffer-frame
;; FIXME: What happens with multi-terminal sessions?
(let ((frames (frame-list))
(count 0))
;; Reset desktop-mini for all frames
(dolist (frame frames)
(set-frame-parameter frame 'desktop-mini nil))
;; Number all frames with its own minibuffer
(dolist (frame (minibuffer-frame-list))
(set-frame-parameter frame 'desktop-mini
(list t
(setq count (1+ count))
(eq frame default-minibuffer-frame))))
;; Now link minibufferless frames with their minibuffer frames
(dolist (frame frames)
(unless (frame-parameter frame 'desktop-mini)
(let* ((mb-frame (window-frame (minibuffer-window frame)))
(this (cadr (frame-parameter mb-frame 'desktop-mini))))
(set-frame-parameter frame 'desktop-mini (list nil this nil)))))))
(defun desktop--save-frames ()
"Save window/frame state, as a global variable.
@ -900,12 +1076,14 @@ Intended to be called from `desktop-save'.
Internal use only."
(setq desktop--saved-states
(and desktop-restore-frames
(mapcar (lambda (frame)
(cons (desktop--filter-frame-parms frame)
(window-state-get (frame-root-window frame) t)))
(cons (selected-frame)
(delq (selected-frame) (frame-list))))))
(desktop-outvar 'desktop--saved-states))
(progn
(desktop--save-minibuffer-frames)
(mapcar (lambda (frame)
(cons (desktop--filter-frame-parms (frame-parameters frame) t)
(window-state-get (frame-root-window frame) t)))
(frame-list)))))
(unless (memq 'desktop--saved-states desktop-globals-to-save)
(desktop-outvar 'desktop--saved-states)))
;;;###autoload
(defun desktop-save (dirname &optional release auto-save)
@ -1006,71 +1184,220 @@ This function also sets `desktop-dirname' to nil."
(defvar desktop-lazy-timer nil)
;; ----------------------------------------------------------------------------
(defun desktop--restore-in-this-display-p ()
(or desktop-restore-in-current-display
(and (eq system-type 'windows-nt) (not (display-graphic-p)))))
(defvar desktop--reuse-list nil
"Internal use only.")
(defun desktop--find-frame-in-display (frames display)
(let (result)
(while (and frames (not result))
(if (equal display (frame-parameter (car frames) 'display))
(setq result (car frames))
(setq frames (cdr frames))))
result))
(defun desktop--find-frame (predicate display &rest args)
"Find a suitable frame in `desktop--reuse-list'.
Look through frames whose display property matches DISPLAY and
return the first one for which (PREDICATE frame ARGS) returns t.
If PREDICATE is nil, it is always satisfied. Internal use only.
This is an auxiliary function for `desktop--select-frame'."
(catch :found
(dolist (frame desktop--reuse-list)
(when (and (equal (frame-parameter frame 'display) display)
(or (null predicate)
(apply predicate frame args)))
(throw :found frame)))
nil))
(defun desktop--make-full-frame (full display config)
(let ((width (and (eq full 'fullheight) (cdr (assq 'width config))))
(height (and (eq full 'fullwidth) (cdr (assq 'height config))))
(params '((visibility)))
(defun desktop--select-frame (display frame-cfg)
"Look for an existing frame to reuse.
DISPLAY is the display where the frame will be shown, and FRAME-CFG
is the parameter list of the frame being restored. Internal use only."
(if (eq desktop-restoring-reuses-frames t)
(let ((frame nil)
mini)
;; There are no fancy heuristics there. We could implement some
;; based on frame size and/or position, etc., but it is not clear
;; that any "gain" (in the sense of reduced flickering, etc.) is
;; worth the added complexity. In fact, the code below mainly
;; tries to work nicely when M-x desktop-read is used after a desktop
;; session has already been loaded. The other main use case, which
;; is the initial desktop-read upon starting Emacs, should usually
;; only have one, or very few, frame(s) to reuse.
(cond (;; When the target is tty, every existing frame is reusable.
(null display)
(setq frame (desktop--find-frame nil display)))
(;; If the frame has its own minibuffer, let's see whether
;; that frame has already been loaded (which can happen after
;; M-x desktop-read).
(car (setq mini (cdr (assq 'desktop-mini frame-cfg))))
(setq frame (or (desktop--find-frame
(lambda (f m)
(equal (frame-parameter f 'desktop-mini) m))
display mini))))
(;; For minibufferless frames, check whether they already exist,
;; and that they are linked to the right minibuffer frame.
mini
(setq frame (desktop--find-frame
(lambda (f n)
(let ((m (frame-parameter f 'desktop-mini)))
(and m
(null (car m))
(= (cadr m) n)
(equal (cadr (frame-parameter
(window-frame (minibuffer-window f))
'desktop-mini))
n))))
display (cadr mini))))
(;; Default to just finding a frame in the same display.
t
(setq frame (desktop--find-frame nil display))))
;; If found, remove from the list.
(when frame
(setq desktop--reuse-list (delq frame desktop--reuse-list)))
frame)
(when width
(setq params (append `((user-size . t) (width . ,width)) params)
config (assq-delete-all 'height config)))
(when height
(setq params (append `((user-size . t) (height . ,height)) params)
config (assq-delete-all 'width config)))
(setq frame (make-frame-on-display display params))
(modify-frame-parameters frame config)
nil))
(defun desktop--make-frame (frame-cfg window-cfg)
"Set up a frame according to its saved state.
That means either creating a new frame or reusing an existing one.
FRAME-CFG is the parameter list of the new frame; WINDOW-CFG is
its window state. Internal use only."
(let* ((fullscreen (cdr (assq 'fullscreen frame-cfg)))
(lines (assq 'tool-bar-lines frame-cfg))
(filtered-cfg (desktop--filter-frame-parms frame-cfg nil))
(display (cdr (assq 'display filtered-cfg))) ;; post-filtering
alt-cfg frame)
;; This works around bug#14795 (or feature#14795, if not a bug :-)
(setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
(push '(tool-bar-lines . 0) filtered-cfg)
(when fullscreen
;; Currently Emacs has the limitation that it does not record the size
;; and position of a frame before maximizing it, so we cannot save &
;; restore that info. Instead, when restoring, we resort to creating
;; invisible "fullscreen" frames of default size and then maximizing them
;; (and making them visible) which at least is somewhat user-friendly
;; when these frames are later de-maximized.
(let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg))))
(height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg))))
(visible (assq 'visibility filtered-cfg)))
(dolist (parameter '(visibility fullscreen width height))
(setq filtered-cfg (assq-delete-all parameter filtered-cfg)))
(when width
(setq filtered-cfg (append `((user-size . t) (width . ,width))
filtered-cfg)))
(when height
(setq filtered-cfg (append `((user-size . t) (height . ,height))
filtered-cfg)))
;; These are parameters to apply after creating/setting the frame.
(push visible alt-cfg)
(push (cons 'fullscreen fullscreen) alt-cfg)))
;; Time to select or create a frame an apply the big bunch of parameters
(if (setq frame (desktop--select-frame display filtered-cfg))
(modify-frame-parameters frame filtered-cfg)
(setq frame (make-frame-on-display display filtered-cfg)))
;; Let's give the finishing touches (visibility, tool-bar, maximization).
(when lines (push lines alt-cfg))
(when alt-cfg (modify-frame-parameters frame alt-cfg))
;; Now restore window state.
(window-state-put window-cfg (frame-root-window frame) 'safe)
frame))
(defun desktop--sort-states (state1 state2)
;; Order: default minibuffer frame
;; other frames with minibuffer, ascending ID
;; minibufferless frames, ascending ID
(let ((dm1 (cdr (assq 'desktop-mini (car state1))))
(dm2 (cdr (assq 'desktop-mini (car state2)))))
(cond ((nth 2 dm1) t)
((nth 2 dm2) nil)
((null (car dm2)) t)
((null (car dm1)) nil)
(t (< (cadr dm1) (cadr dm2))))))
(defun desktop--restore-frames ()
"Restore window/frame configuration.
Internal use only."
(when (and desktop-restore-frames desktop--saved-states)
(let ((frames (frame-list))
(current (frame-parameter nil 'display))
(selected nil))
(let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer
(visible nil)
(delete-saved (eq desktop-restore-in-current-display 'delete))
(forcing (not (desktop-restore-in-original-display-p)))
(target (and forcing (cons 'display (frame-parameter nil 'display)))))
;; Sorting saved states allows us to easily restore minibuffer-owning frames
;; before minibufferless ones.
(setq desktop--saved-states (sort desktop--saved-states #'desktop--sort-states))
;; Potentially all existing frames are reusable. Later we will decide which ones
;; to reuse, and how to deal with any leftover.
(setq desktop--reuse-list (frame-list))
(dolist (state desktop--saved-states)
(condition-case err
(let* ((config (car state))
(display (if (desktop--restore-in-this-display-p)
(setcdr (assq 'display config) current)
(cdr (assq 'display config))))
(full (cdr (assq 'fullscreen config)))
(frame (and (not full)
(desktop--find-frame-in-display frames display))))
(cond (full
;; treat fullscreen/maximized frames specially
(setq frame (desktop--make-full-frame full display config)))
(frame
;; found a frame in the right display -- reuse
(setq frames (delq frame frames))
(modify-frame-parameters frame config))
(t
;; no frames in the display -- make a new one
(setq frame (make-frame-on-display display config))))
;; restore windows
(window-state-put (cdr state) (frame-root-window frame) 'safe)
(unless selected (setq selected frame)))
(let* ((frame-cfg (car state))
(window-cfg (cdr state))
(d-mini (cdr (assq 'desktop-mini frame-cfg)))
num frame to-tty)
;; Only set target if forcing displays and the target display is different.
(if (or (not forcing)
(equal target (or (assq 'display frame-cfg) '(display . nil))))
(setq desktop--target-display nil)
(setq desktop--target-display target
to-tty (null (cdr target))))
;; Time to restore frames and set up their minibuffers as they were.
;; We only skip a frame (thus deleting it) if either:
;; - we're switching displays, and the user chose the option to delete, or
;; - we're switching to tty, and the frame to restore is minibuffer-only.
(unless (and desktop--target-display
(or delete-saved
(and to-tty
(eq (cdr (assq 'minibuffer frame-cfg)) 'only))))
;; Restore minibuffers. Some of this stuff could be done in a filter
;; function, but it would be messy because restoring minibuffers affects
;; global state; it's best to do it here than add a bunch of global
;; variables to pass info back-and-forth to/from the filter function.
(cond
((null d-mini)) ;; No desktop-mini. Process as normal frame.
(to-tty) ;; Ignore minibuffer stuff and process as normal frame.
((car d-mini) ;; Frame has its own minibuffer (or it is minibuffer-only).
(setq num (cadr d-mini))
(when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
(setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0))
frame-cfg))))
(t ;; Frame depends on other frame's minibufer window.
(let ((mb-frame (cdr (assq (cadr d-mini) frame-mb-map))))
(unless (frame-live-p mb-frame)
(error "Minibuffer frame %s not found" (cadr d-mini)))
(let ((mb-param (assq 'minibuffer frame-cfg))
(mb-window (minibuffer-window mb-frame)))
(unless (and (window-live-p mb-window)
(window-minibuffer-p mb-window))
(error "Not a minibuffer window %s" mb-window))
(if mb-param
(setcdr mb-param mb-window)
(push (cons 'minibuffer mb-window) frame-cfg))))))
;; OK, we're ready at last to create (or reuse) a frame and
;; restore the window config.
(setq frame (desktop--make-frame frame-cfg window-cfg))
;; Set default-minibuffer if required.
(when (nth 2 d-mini) (setq default-minibuffer-frame frame))
;; Store frame/NUM to assign to minibufferless frames.
(when num (push (cons num frame) frame-mb-map))
;; Try to locate at least one visible frame.
(when (and (not visible) (frame-visible-p frame))
(setq visible frame))))
(error
(message "Error restoring frame: %S" (error-message-string err)))))
(when selected
;; make sure the original selected frame is visible and selected
(unless (or (frame-parameter selected 'visibility) (daemonp))
(modify-frame-parameters selected '((visibility . t))))
(select-frame-set-input-focus selected)
;; delete any remaining frames
(mapc #'delete-frame frames)))))
(delay-warning 'desktop (error-message-string err) :error))))
;; Delete remaining frames, but do not fail if some resist being deleted.
(unless (eq desktop-restoring-reuses-frames 'keep)
(dolist (frame desktop--reuse-list)
(ignore-errors (delete-frame frame))))
(setq desktop--reuse-list nil)
;; Make sure there's at least one visible frame, and select it.
(unless (or visible (daemonp))
(setq visible (if (frame-live-p default-minibuffer-frame)
default-minibuffer-frame
(car (frame-list))))
(make-frame-visible visible)
(select-frame-set-input-focus visible)))))
;;;###autoload
(defun desktop-read (&optional dirname)

3
lisp/edmacro.el
View file

@ -562,7 +562,8 @@ doubt, use whitespace."
(unless (string-match " " desc)
(let ((times 1) (pos bind-len))
(while (not (cl-mismatch rest-mac rest-mac
0 bind-len pos (+ bind-len pos)))
:start1 0 :end1 bind-len
:start2 pos :end2 (+ bind-len pos)))
(cl-incf times)
(cl-incf pos bind-len))
(when (> times 1)

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)

40
lisp/filenotify.el
View file

@ -27,8 +27,7 @@
;;; Code:
;;;###autoload
(defconst file-notify-support
(defconst file-notify--library
(cond
((featurep 'gfilenotify) 'gfilenotify)
((featurep 'inotify) 'inotify)
@ -191,6 +190,17 @@ car of that event, which is the symbol `file-notify'."
(funcall callback (list desc action file file1))
(funcall callback (list desc action file)))))))
(defun file-notify-supported-p (file)
"Returns non-nil if filesystem pertaining to FILE could be watched."
(unless (stringp file)
(signal 'wrong-type-argument (list file)))
(setq file (expand-file-name file))
(let ((handler (find-file-name-handler file 'file-notify-supported-p)))
(if handler
(funcall handler 'file-notify-supported-p file)
(and file-notify--library t))))
(defun file-notify-add-watch (file flags callback)
"Add a watch for filesystem events pertaining to FILE.
This arranges for filesystem events pertaining to FILE to be reported
@ -238,7 +248,7 @@ FILE is the name of the file whose event is being reported."
(let* ((handler (find-file-name-handler file 'file-notify-add-watch))
(dir (directory-file-name
(if (or (and (not handler) (eq file-notify-support 'w32notify))
(if (or (and (not handler) (eq file-notify--library 'w32notify))
(file-directory-p file))
file
(file-name-directory file))))
@ -259,32 +269,32 @@ FILE is the name of the file whose event is being reported."
;; Check, whether Emacs has been compiled with file
;; notification support.
(unless file-notify-support
(unless file-notify--library
(signal 'file-notify-error
'("No file notification package available")))
;; Determine low-level function to be called.
(setq func (cond
((eq file-notify-support 'gfilenotify) 'gfile-add-watch)
((eq file-notify-support 'inotify) 'inotify-add-watch)
((eq file-notify-support 'w32notify) 'w32notify-add-watch)))
((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
((eq file-notify--library 'inotify) 'inotify-add-watch)
((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
;; Determine respective flags.
(if (eq file-notify-support 'gfilenotify)
(if (eq file-notify--library 'gfilenotify)
(setq l-flags '(watch-mounts send-moved))
(when (memq 'change flags)
(setq
l-flags
(cond
((eq file-notify-support 'inotify) '(create modify move delete))
((eq file-notify-support 'w32notify)
((eq file-notify--library 'inotify) '(create modify move delete))
((eq file-notify--library 'w32notify)
'(file-name directory-name size last-write-time)))))
(when (memq 'attribute-change flags)
(add-to-list
'l-flags
(cond
((eq file-notify-support 'inotify) 'attrib)
((eq file-notify-support 'w32notify) 'attributes)))))
((eq file-notify--library 'inotify) 'attrib)
((eq file-notify--library 'w32notify) 'attributes)))))
;; Call low-level function.
(setq desc (funcall func dir l-flags 'file-notify-callback))))
@ -311,9 +321,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(funcall handler 'file-notify-rm-watch descriptor)
(funcall
(cond
((eq file-notify-support 'gfilenotify) 'gfile-rm-watch)
((eq file-notify-support 'inotify) 'inotify-rm-watch)
((eq file-notify-support 'w32notify) 'w32notify-rm-watch))
((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
((eq file-notify--library 'inotify) 'inotify-rm-watch)
((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
descriptor)))
(remhash descriptor file-notify-descriptors)))

44
lisp/frame.el
View file

@ -1671,6 +1671,16 @@ left untouched. FRAME nil or omitted means use the selected frame."
:type 'number
:group 'cursor)
(defcustom blink-cursor-blinks 10
"How many times to blink before using a solid cursor on NS and X.
Use 0 or negative value to blink forever."
:version "24.4"
:type 'integer
:group 'cursor)
(defvar blink-cursor-blinks-done 1
"Number of blinks done since we started blinking on NS and X")
(defvar blink-cursor-idle-timer nil
"Timer started after `blink-cursor-delay' seconds of Emacs idle time.
The function `blink-cursor-start' is called when the timer fires.")
@ -1688,6 +1698,7 @@ command starts, by installing a pre-command hook."
(when (null blink-cursor-timer)
;; Set up the timer first, so that if this signals an error,
;; blink-cursor-end is not added to pre-command-hook.
(setq blink-cursor-blinks-done 1)
(setq blink-cursor-timer
(run-with-timer blink-cursor-interval blink-cursor-interval
'blink-cursor-timer-function))
@ -1696,7 +1707,15 @@ command starts, by installing a pre-command hook."
(defun blink-cursor-timer-function ()
"Timer function of timer `blink-cursor-timer'."
(internal-show-cursor nil (not (internal-show-cursor-p))))
(internal-show-cursor nil (not (internal-show-cursor-p)))
;; Each blink is two calls to this function.
(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))
(blink-cursor-suspend)
(add-hook 'post-command-hook 'blink-cursor-check))))
(defun blink-cursor-end ()
"Stop cursor blinking.
@ -1709,6 +1728,29 @@ itself as a pre-command hook."
(cancel-timer blink-cursor-timer)
(setq blink-cursor-timer nil)))
(defun blink-cursor-suspend ()
"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 w32))
(blink-cursor-end)
(when blink-cursor-idle-timer
(cancel-timer blink-cursor-idle-timer)
(setq blink-cursor-idle-timer nil))))
(defun blink-cursor-check ()
"Check if cursot blinking shall be restarted.
This is done when a frame gets focus. Blink timers may be stopped by
`blink-cursor-suspend'."
(when (and blink-cursor-mode
(not blink-cursor-idle-timer))
(remove-hook 'post-command-hook 'blink-cursor-check)
(setq blink-cursor-idle-timer
(run-with-idle-timer blink-cursor-delay
blink-cursor-delay
'blink-cursor-start))))
(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
(define-minor-mode blink-cursor-mode

15
lisp/gnus/ChangeLog
View file

@ -1,3 +1,18 @@
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
that the old Emacs 24s bundle.
2013-07-10 David Engster <deng@randomsample.de>
* gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks

13
lisp/gnus/gnus-art.el
View file

@ -6197,9 +6197,14 @@ Provided for backwards compatibility."
(defun gnus-shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Enable image to be deleted."
(let ((image (shr-put-image data (propertize (or alt "*")
'gnus-image-category 'shr)
flags)))
(let ((image (if flags
(shr-put-image data (propertize (or alt "*")
'gnus-image-category 'shr)
flags)
;; Old `shr-put-image' doesn't take the optional `flags'
;; argument.
(shr-put-image data (propertize (or alt "*")
'gnus-image-category 'shr)))))
(when image
(gnus-add-image 'shr image))))
@ -8414,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."

2
lisp/gnus/registry.el
View file

@ -228,7 +228,7 @@ With assert non-nil, errors out if the key does not exist already."
(let ((entry (gethash key data)))
(when assert
(assert entry nil
"Key %s does not exists in database" key))
"Key %s does not exist in database" key))
;; clean entry from the secondary indices
(dolist (tr tracked)
;; is this tracked symbol indexed?

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

3
lisp/net/tramp-adb.el
View file

@ -108,6 +108,9 @@
(file-writable-p . tramp-adb-handle-file-writable-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-supported-p . ignore)
(expand-file-name . tramp-adb-handle-expand-file-name)
(find-backup-file-name . tramp-handle-find-backup-file-name)
(directory-files . tramp-handle-directory-files)

4
lisp/net/tramp-compat.el
View file

@ -184,7 +184,7 @@
'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
(ad-activate 'file-expand-wildcards)))))
;; `with-temp-message' does not exists in XEmacs.
;; `with-temp-message' does not exist in XEmacs.
(if (fboundp 'with-temp-message)
(defalias 'tramp-compat-with-temp-message 'with-temp-message)
(defmacro tramp-compat-with-temp-message (message &rest body)
@ -292,7 +292,7 @@ Not actually used. Use `(format \"%o\" i)' instead?"
(error "Non-octal junk in string `%s'" x))
(string-to-number ostr 8)))
;; ID-FORMAT does not exists in XEmacs.
;; ID-FORMAT does not exist in XEmacs.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
(cond

3
lisp/net/tramp-gvfs.el
View file

@ -435,6 +435,9 @@ Every entry is a list (NAME ADDRESS).")
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-supported-p . ignore)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)

13
lisp/net/tramp-sh.el
View file

@ -867,7 +867,8 @@ of command line.")
(set-file-acl . tramp-sh-handle-set-file-acl)
(vc-registered . tramp-sh-handle-vc-registered)
(file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-sh-handle-file-notify-rm-watch))
(file-notify-rm-watch . tramp-sh-handle-file-notify-rm-watch)
(file-notify-supported-p . tramp-sh-handle-file-notify-supported-p))
"Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.")
@ -3334,7 +3335,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; `process-file-side-effects' in order to keep the cache when
;; `process-file' calls appear.
(let (process-file-side-effects)
(tramp-run-real-handler 'vc-registered (list file)))))))
(ignore-errors
(tramp-run-real-handler 'vc-registered (list file))))))))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler (operation &rest args)
@ -3497,6 +3499,13 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-message proc 6 (format "Kill %S" proc))
(kill-process proc))
(defun tramp-sh-handle-file-notify-supported-p (file-name)
"Like `file-notify-supported-p' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name file-name) nil
(and (or (tramp-get-remote-gvfs-monitor-dir v)
(tramp-get-remote-inotifywait v))
t)))
;;; Internal Functions:
(defun tramp-maybe-send-script (vec script name)

3
lisp/net/tramp-smb.el
View file

@ -209,6 +209,9 @@ See `tramp-actions-before-shell' for more info.")
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . ignore)
(file-notify-rm-watch . ignore)
(file-notify-supported-p . ignore)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)

4
lisp/net/tramp.el
View file

@ -1980,8 +1980,8 @@ ARGS are the arguments OPERATION has been called with."
;; Emacs 22+ only.
'set-file-times
;; Emacs 24+ only.
'file-acl 'file-notify-add-watch 'file-selinux-context
'set-file-acl 'set-file-selinux-context
'file-acl 'file-notify-add-watch 'file-notify-supported-p
'file-selinux-context 'set-file-acl 'set-file-selinux-context
;; XEmacs only.
'abbreviate-file-name 'create-file-buffer
'dired-file-modtime 'dired-make-compressed-filename

2
lisp/org/org-freemind.el
View file

@ -598,7 +598,7 @@ DRAWERS-REGEXP are converted to freemind notes."
(defun org-freemind-check-overwrite (file interactively)
"Check if file FILE already exists.
If FILE does not exists return t.
If FILE does not exist return t.
If INTERACTIVELY is non-nil ask if the file should be replaced
and return t/nil if it should/should not be replaced.

43
lisp/progmodes/ruby-mode.el
View file

@ -46,11 +46,6 @@
:prefix "ruby-"
:group 'languages)
(defconst ruby-keyword-end-re
(if (string-match "\\_>" "ruby")
"\\_>"
"\\>"))
(defconst ruby-block-beg-keywords
'("class" "module" "def" "if" "unless" "case" "while" "until" "for" "begin" "do")
"Keywords at the beginning of blocks.")
@ -60,7 +55,7 @@
"Regexp to match the beginning of blocks.")
(defconst ruby-non-block-do-re
(concat (regexp-opt '("while" "until" "for" "rescue") t) ruby-keyword-end-re)
(regexp-opt '("while" "until" "for" "rescue") 'symbols)
"Regexp to match keywords that nest without blocks.")
(defconst ruby-indent-beg-re
@ -696,7 +691,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
((looking-at (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>"))
(and
(save-match-data
(or (not (looking-at (concat "do" ruby-keyword-end-re)))
(or (not (looking-at "do\\_>"))
(save-excursion
(back-to-indentation)
(not (looking-at ruby-non-block-do-re)))))
@ -1718,14 +1713,16 @@ See the definition of `ruby-font-lock-syntactic-keywords'."
"The syntax table to use for fontifying Ruby mode buffers.
See `font-lock-syntax-table'.")
(defconst ruby-font-lock-keyword-beg-re "\\(?:^\\|[^.@$]\\|\\.\\.\\)")
(defconst ruby-font-lock-keywords
(list
;; functions
'("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)"
1 font-lock-function-name-face)
;; keywords
(list (concat
"\\(^\\|[^.@$]\\|\\.\\.\\)\\("
;; keywords
ruby-font-lock-keyword-beg-re
(regexp-opt
'("alias"
"and"
@ -1760,11 +1757,14 @@ See `font-lock-syntax-table'.")
"when"
"while"
"yield")
'symbols)
"\\|"
'symbols))
1 'font-lock-keyword-face)
;; some core methods
(list (concat
ruby-font-lock-keyword-beg-re
(regexp-opt
;; built-in methods on Kernel
'("__callee__"
'(;; built-in methods on Kernel
"__callee__"
"__dir__"
"__method__"
"abort"
@ -1823,20 +1823,17 @@ See `font-lock-syntax-table'.")
"public"
"refine"
"using")
'symbols)
"\\)")
2
'(if (match-beginning 4)
font-lock-builtin-face
font-lock-keyword-face))
'symbols))
1 'font-lock-builtin-face)
;; Perl-ish keywords
"\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$"
;; here-doc beginnings
`(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0))
'font-lock-string-face))
;; variables
'("\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(nil\\|self\\|true\\|false\\)\\>"
2 font-lock-variable-name-face)
`(,(concat ruby-font-lock-keyword-beg-re
"\\_<\\(nil\\|self\\|true\\|false\\)\\>")
1 font-lock-variable-name-face)
;; keywords that evaluate to certain values
'("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>" 0 font-lock-variable-name-face)
;; symbols
@ -1852,7 +1849,7 @@ See `font-lock-syntax-table'.")
1 (unless (eq ?\( (char-after)) font-lock-type-face))
'("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
;; conversion methods on Kernel
(list (concat "\\(?:^\\|[^.@$]\\|\\.\\.\\)"
(list (concat ruby-font-lock-keyword-beg-re
(regexp-opt '("Array" "Complex" "Float" "Hash"
"Integer" "Rational" "String") 'symbols))
1 font-lock-builtin-face)
@ -1864,7 +1861,7 @@ See `font-lock-syntax-table'.")
1 font-lock-negation-char-face)
;; character literals
;; FIXME: Support longer escape sequences.
'("\\?\\\\?\\S " 0 font-lock-string-face)
'("\\_<\\?\\\\?\\S " 0 font-lock-string-face)
)
"Additional expressions to highlight in Ruby mode.")

18
lisp/shell.el
View file

@ -284,21 +284,9 @@ Value is a list of strings, which may be nil."
;; Note: There are no explicit references to the variable `explicit-bash-args'.
;; It is used implicitly by M-x shell when the interactive shell is `bash'.
(defcustom explicit-bash-args
(let* ((prog (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
(getenv "ESHELL") shell-file-name))
(name (file-name-nondirectory prog)))
;; Tell bash not to use readline, except for bash 1.x which
;; doesn't grok --noediting. Bash 1.x has -nolineediting, but
;; process-send-eof cannot terminate bash if we use it.
(if (and (not purify-flag)
(equal name "bash")
(file-executable-p prog)
(string-match "bad option"
(shell-command-to-string
(concat (shell-quote-argument prog)
" --noediting"))))
'("-i")
'("--noediting" "-i")))
;; Tell bash not to use readline. It's safe to assume --noediting now,
;; as it was introduced in 1996 in Bash version 2.
'("--noediting" "-i")
"Args passed to inferior shell by \\[shell], if the shell is bash.
Value is a list of strings, which may be nil."
:type '(repeat (string :tag "Argument"))

21
lisp/simple.el
View file

@ -4800,6 +4800,8 @@ The value is a floating-point number."
(this-ypos (nth 2 this-lh))
(dlh (default-line-height))
(wslines (window-screen-lines))
(edges (window-inside-pixel-edges))
(winh (- (nth 3 edges) (nth 1 edges) 1))
py vs last-line)
(if (> (mod wslines 1.0) 0.0)
(setq wslines (round (+ wslines 0.5))))
@ -4848,7 +4850,7 @@ The value is a floating-point number."
nil)
;; If cursor is not in the bottom scroll margin, and the
;; current line is is not too tall, move forward.
((and (or (null this-height) (<= this-height dlh))
((and (or (null this-height) (<= this-height winh))
vpos
(> vpos 0)
(< py last-line))
@ -4865,7 +4867,7 @@ The value is a floating-point number."
(> vpos 0)
(= py last-line))
;; Don't vscroll if the partially-visible line at window
;; bottom has the default height (a.k.a. "just one more text
;; bottom is not too tall (a.k.a. "just one more text
;; line"): in that case, we do want redisplay to behave
;; normally, i.e. recenter or whatever.
;;
@ -4874,7 +4876,7 @@ The value is a floating-point number."
;; partially-visible glyph row at the end of the window. As
;; we are dealing with floats, we disregard sub-pixel
;; discrepancies between that and DLH.
(if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1))
(if (and rowh rbot (>= (- (+ rowh rbot) winh) 1))
(set-window-vscroll nil dlh t))
(line-move-1 arg noerror to-end)
t)
@ -4918,10 +4920,13 @@ The value is a floating-point number."
;; If we moved into a tall line, set vscroll to make
;; scrolling through tall images more smooth.
(let ((lh (line-pixel-height))
(dlh (default-line-height)))
(edges (window-inside-pixel-edges))
(dlh (default-line-height))
winh)
(setq winh (- (nth 3 edges) (nth 1 edges) 1))
(if (and (< arg 0)
(< (point) (window-start))
(> lh dlh))
(> lh winh))
(set-window-vscroll
nil
(- lh dlh) t))))
@ -7437,19 +7442,19 @@ warning using STRING as the message.")
;;; Generic dispatcher commands
;; Macro `alternatives-define' is used to create generic commands.
;; Macro `define-alternatives' is used to create generic commands.
;; Generic commands are these (like web, mail, news, encrypt, irc, etc.)
;; that can have different alternative implementations where choosing
;; among them is exclusively a matter of user preference.
;; (alternatives-define COMMAND) creates a new interactive command
;; (define-alternatives COMMAND) creates a new interactive command
;; M-x COMMAND and a customizable variable COMMAND-alternatives.
;; Typically, the user will not need to customize this variable; packages
;; wanting to add alternative implementations should use
;;
;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives
(defmacro alternatives-define (command &rest customizations)
(defmacro define-alternatives (command &rest customizations)
"Define new command `COMMAND'.
The variable `COMMAND-alternatives' will contain alternative
implementations of COMMAND, so that running `C-u M-x COMMAND'

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)

409
src/ChangeLog
View file

@ -1,5 +1,414 @@
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.
(get_boot_time_1): Rework to avoid using emacs_open.
This doesn't actually fix a leak, but is better anyway.
(read_lock_data): Use read, not emacs_read.
* doc.c: Fix minor memory and file descriptor leaks.
* doc.c (get_doc_string): Fix memory leak when doc file absent.
(get_doc_string, Fsnarf_documentation):
Fix file descriptor leak on error.
* term.c: Fix minor fdopen-related file descriptor leaks.
* term.c (Fresume_tty) [!MSDOS]: Close fd if fdopen (fd) fails.
(init_tty) [!DOS_NT]: Likewise. Also close fd if isatty (fd) fails.
* charset.c: Fix file descriptor leaks and errno issues.
Include <errno.h>.
(load_charset_map_from_file): Don't leak file descriptor on error.
Use plain record_xmalloc since the allocation is larger than
MAX_ALLOCA; that's simpler here. Simplify test for exhaustion
of entries.
* eval.c (record_unwind_protect_nothing):
* fileio.c (fclose_unwind):
New functions.
* lread.c (load_unwind): Remove. All uses replaced by fclose_unwind.
The replacement doesn't block input, but that no longer seems
necessary.
2013-07-17 Paul Eggert <eggert@cs.ucla.edu>
* lread.c: Fix file descriptor leaks and errno issues.
(Fload): Close some races that leaked fds or streams when 'load'
was interrupted.
(Fload, openp): Report error number of last nontrivial failure to open.
ENOENT counts as trivial.
* eval.c (do_nothing, clear_unwind_protect, set_unwind_protect_ptr):
New functions.
* fileio.c (close_file_unwind): No need to test whether FD is nonnegative,
now that the function is always called with a nonnegative arg.
* lisp.h (set_unwind_protect_ptr, set_unwind_protect_int): Remove.
All uses replaced with ...
(clear_unwind_protect, set_unwind_protect_ptr): New decls.
A few more minor file errno-reporting bugs.
* callproc.c (Fcall_process):
* doc.c (Fsnarf_documentation):
* fileio.c (Frename_file, Fadd_name_to_file, Fmake_symbolic_link):
* process.c (set_socket_option):
Don't let a constructor trash errno.
* doc.c: Include <errno.h>.
2013-07-16 Juanma Barranquero <lekktu@gmail.com>
* w32fns.c (unwind_create_tip_frame): Fix declaration.
2013-07-16 Paul Eggert <eggert@cs.ucla.edu>
Fix w32 bug with call-process-region (Bug#14885).
* callproc.c (Fcall_process_region): Pass nil, not "/dev/null",
to Fcall_process when the input is empty. This simplifies the
code a bit. It makes no difference on POSIXish platforms but
apparently it fixes a bug on w32.
Fix bug where insert-file-contents closes a file twice. (Bug#14839).
* fileio.c (close_file_unwind): Don't close if FD is negative;
this can happen when unwinding a zapped file descriptor.
(Finsert_file_contents): Unwind-protect the fd before the point marker,
in case Emacs runs out of memory between the two unwind-protects.
Don't trash errno when closing FD.
Zap the FD in the specpdl when closing it, instead of deferring
the removal of the unwind-protect; this fixes a bug where a child
function unwinds the stack past us.
New unwind-protect flavors to better type-check C callbacks.
This also lessens the need to write wrappers for callbacks,
and the need for make_save_pointer.
* alloca.c (free_save_value):
* atimer.c (run_all_atimers):
Now extern.
* alloc.c (safe_alloca_unwind):
* atimer.c (unwind_stop_other_atimers):
* keyboard.c (cancel_hourglass_unwind) [HAVE_WINDOW_SYSTEM]:
* menu.c (cleanup_popup_menu) [HAVE_NS]:
* minibuf.c (choose_minibuf_frame_1):
* process.c (make_serial_process_unwind):
* xdisp.h (pop_message_unwind):
* xselect.c (queue_selection_requests_unwind):
Remove no-longer-needed wrapper. All uses replaced by the wrappee.
* alloca.c (record_xmalloc):
Prefer record_unwind_protect_ptr to record_unwind_protect with
make_save_pointer.
* alloca.c (Fgarbage_collect):
Prefer record_unwind_protect_void to passing a dummy.
* buffer.c (restore_buffer):
* window.c (restore_window_configuration):
* xfns.c, w32fns.c (do_unwind_create_frame)
New wrapper. All record-unwind uses of wrappee changed.
* buffer.c (set_buffer_if_live):
* callproc.c (call_process_cleanup, delete_temp_file):
* coding.c (code_conversion_restore):
* dired.c (directory_files_internal_w32_unwind) [WINDOWSNT]:
* editfns.c (save_excursion_restore)
(subst_char_in_region_unwind, subst_char_in_region_unwind_1)
(save_restriction_restore):
* eval.c (restore_stack_limits, un_autoload):
* fns.c (require_unwind):
* keyboard.c (recursive_edit_unwind, tracking_off):
* lread.c (record_load_unwind, load_warn_old_style_backquotes):
* macros.c (pop_kbd_macro, restore_menu_items):
* nsfns.m (unwind_create_frame):
* print.c (print_unwind):
* process.c (start_process_unwind):
* search.c (unwind_set_match_data):
* window.c (select_window_norecord, select_frame_norecord):
* xdisp.c (unwind_with_echo_area_buffer, unwind_format_mode_line)
(fast_set_selected_frame):
* xfns.c, w32fns.c (unwind_create_tip_frame):
Return void, not a dummy Lisp_Object. All uses changed.
* buffer.h (set_buffer_if_live): Move decl here from lisp.h.
* callproc.c (call_process_kill):
* fileio.c (restore_point_unwind, decide_coding_unwind)
(build_annotations_unwind):
* insdel.c (Fcombine_after_change_execute_1):
* keyboard.c (read_char_help_form_unwind):
* menu.c (unuse_menu_items):
* minibuf.c (run_exit_minibuf_hook, read_minibuf_unwind):
* sound.c (sound_cleanup):
* xdisp.c (unwind_redisplay):
* xfns.c (clean_up_dialog):
* xselect.c (x_selection_request_lisp_error, x_catch_errors_unwind):
Accept no args and return void, instead of accepting and returning
a dummy Lisp_Object. All uses changed.
* cygw32.c (fchdir_unwind):
* fileio.c (close_file_unwind):
* keyboard.c (restore_kboard_configuration):
* lread.c (readevalllop_1):
* process.c (wait_reading_process_output_unwind):
Accept int and return void, rather than accepting an Emacs integer
and returning a dummy object. In some cases this fixes an
unlikely bug when the corresponding int is outside Emacs integer
range. All uses changed.
* dired.c (directory_files_internal_unwind):
* fileio.c (do_auto_save_unwind):
* gtkutil.c (pop_down_dialog):
* insdel.c (reset_var_on_error):
* lread.c (load_unwind):
* xfns.c (clean_up_file_dialog):
* xmenu.c, nsmenu.m (pop_down_menu):
* xmenu.c (cleanup_widget_value_tree):
* xselect.c (wait_for_property_change_unwind):
Accept pointer and return void, rather than accepting an Emacs
save value encapsulating the pointer and returning a dummy object.
All uses changed.
* editfns.c (Fformat): Update the saved pointer directly via
set_unwind_protect_ptr rather than indirectly via make_save_pointer.
* eval.c (specpdl_func): Remove. All uses replaced by definiens.
(unwind_body): New function.
(record_unwind_protect): First arg is now a function returning void,
not a dummy Lisp_Object.
(record_unwind_protect_ptr, record_unwind_protect_int)
(record_unwind_protect_void): New functions.
(unbind_to): Support SPECPDL_UNWIND_PTR etc.
* fileio.c (struct auto_save_unwind): New type.
(do_auto_save_unwind): Use it.
(do_auto_save_unwind_1): Remove; subsumed by new do_auto_save_unwind.
* insdel.c (struct rvoe_arg): New type.
(reset_var_on_error): Use it.
* lisp.h (SPECPDL_UNWIND_PTR, SPECPDL_UNWIND_INT, SPECPDL_UNWIND_VOID):
New constants.
(specbinding_func): Remove; there are now several such functions.
(union specbinding): New members unwind_ptr, unwind_int, unwind_void.
(set_unwind_protect_ptr): New function.
* xselect.c: Remove unnecessary forward decls, to simplify maintenance.
Be simpler and more consistent about reporting I/O errors.
* fileio.c (Fcopy_file, Finsert_file_contents, Fwrite_region):
Say "Read error" and "Write error", rather than "I/O error", or
"IO error reading", or "IO error writing", when a read or write
error occurs.
* process.c (Fmake_network_process, wait_reading_process_output)
(send_process, Fprocess_send_eof, wait_reading_process_output):
Capitalize diagnostics consistently. Put "failed foo" at the
start of the diagnostic, so that we don't capitalize the
function name "foo". Consistently say "failed" for such
diagnostics.
* sysdep.c, w32.c (serial_open): Now accepts Lisp string, not C string.
All callers changed. This is so it can use report_file_error.
* sysdep.c (serial_open, serial_configure): Capitalize I/O
diagnostics consistently as above.
* fileio.c (report_file_errno): Fix errno reporting bug.
If the file name is neither null nor a pair, package it up as a
singleton list. All callers changed, both to this function and to
report_file_error. This fixes a bug where the memory allocator
invoked by list1 set errno so that the immediately following
report_file_error reported the wrong errno value.
Fix minor problems found by --enable-gcc-warnings.
* frame.c (Fhandle_focus_in, Fhandle_focus_out): Return a value.
* keyboard.c (kbd_buffer_get_event): Remove unused local.
2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
* xterm.c (x_focus_changed): Always generate FOCUS_IN_EVENT.
Set event->arg to Qt if switch-event shall be generated.
Generate FOCUS_OUT_EVENT for FocusOut if this is the focused frame.
* termhooks.h (enum event_kind): Add FOCUS_OUT_EVENT.
* nsterm.m (windowDidResignKey): If this is the focused frame, generate
FOCUS_OUT_EVENT.
* keyboard.c (Qfocus_in, Qfocus_out): New static objects.
(make_lispy_focus_in, make_lispy_focus_out): Declare and define.
(kbd_buffer_get_event): For FOCUS_IN, make a focus_in event if no
switch frame event is made. Check ! NILP (event->arg) if X11 (moved
from xterm.c). Make focus_out event for FOCUS_OUT_EVENT if NS or X11
and there is a focused frame.
(head_table): Add focus-in and focus-out.
(keys_of_keyboard): Add focus-in and focus-out to Vspecial_event_map,
bind to handle-focus-in/out.
* frame.c (Fhandle_focus_in, Fhandle_focus_out): New functions.
(Fhandle_switch_frame): Call Fhandle_focus_in.
(syms_of_frame): defsubr handle-focus-in/out.
2013-07-16 Paul Eggert <eggert@cs.ucla.edu>
Fix porting bug to older POSIXish platforms (Bug#14862).
* sysdep.c (emacs_pipe): New function, that implements
pipe2 (fd, O_CLOEXEC) even on hosts that lack O_CLOEXEC.
This should port better to CentOS 5 and to Mac OS X 10.6.
All calls to pipe2 changed.
Prefer list1 (X) to Fcons (X, Qnil) when building lists.
This makes the code easier to read and the executable a bit smaller.
Do not replace all calls to Fcons that happen to create lists,
just calls that are intended to create lists. For example, when
creating an alist that maps FOO to nil, use list1 (Fcons (FOO, Qnil))
rather than list1 (list1 (FOO)) or Fcons (Fcons (FOO, Qnil), Qnil).
Similarly for list2 through list5.
* buffer.c (Fget_buffer_create, Fmake_indirect_buffer):
* bytecode.c (exec_byte_code):
* callint.c (quotify_arg, Fcall_interactively):
* callproc.c (Fcall_process, create_temp_file):
* charset.c (load_charset_map_from_file)
(Fdefine_charset_internal, init_charset):
* coding.c (get_translation_table, detect_coding_system)
(Fcheck_coding_systems_region)
(Fset_terminal_coding_system_internal)
(Fdefine_coding_system_internal, Fdefine_coding_system_alias):
* composite.c (update_compositions, Ffind_composition_internal):
* dired.c (directory_files_internal, file_name_completion)
(Fsystem_users):
* dispnew.c (Fopen_termscript, bitch_at_user, init_display):
* doc.c (Fsnarf_documentation):
* editfns.c (Fmessage_box):
* emacs.c (main):
* eval.c (do_debug_on_call, signal_error, maybe_call_debugger)
(Feval, eval_sub, Ffuncall, apply_lambda):
* fileio.c (make_temp_name, Fcopy_file, Faccess_file)
(Fset_file_selinux_context, Fset_file_acl, Fset_file_modes)
(Fset_file_times, Finsert_file_contents)
(Fchoose_write_coding_system, Fwrite_region):
* fns.c (Flax_plist_put, Fyes_or_no_p, syms_of_fns):
* font.c (font_registry_charsets, font_parse_fcname)
(font_prepare_cache, font_update_drivers, Flist_fonts):
* fontset.c (Fset_fontset_font, Ffontset_info, syms_of_fontset):
* frame.c (make_frame, Fmake_terminal_frame)
(x_set_frame_parameters, x_report_frame_params)
(x_default_parameter, Fx_parse_geometry):
* ftfont.c (syms_of_ftfont):
* image.c (gif_load):
* keyboard.c (command_loop_1):
* keymap.c (Fmake_keymap, Fmake_sparse_keymap, access_keymap_1)
(Fcopy_keymap, append_key, Fcurrent_active_maps)
(Fminor_mode_key_binding, accessible_keymaps_1)
(Faccessible_keymaps, Fwhere_is_internal):
* lread.c (read_emacs_mule_char):
* menu.c (find_and_return_menu_selection):
* minibuf.c (get_minibuffer):
* nsfns.m (Fns_perform_service):
* nsfont.m (ns_script_to_charset):
* nsmenu.m (ns_popup_dialog):
* nsselect.m (ns_get_local_selection, ns_string_from_pasteboard)
(Fx_own_selection_internal):
* nsterm.m (append2):
* print.c (Fredirect_debugging_output)
(print_prune_string_charset):
* process.c (Fdelete_process, Fprocess_contact)
(Fformat_network_address, set_socket_option)
(read_and_dispose_of_process_output, write_queue_push)
(send_process, exec_sentinel):
* sound.c (Fplay_sound_internal):
* textprop.c (validate_plist, add_properties)
(Fput_text_property, Fadd_face_text_property)
(copy_text_properties, text_property_list, syms_of_textprop):
* unexaix.c (report_error):
* unexcoff.c (report_error):
* unexsol.c (unexec):
* xdisp.c (redisplay_tool_bar, store_mode_line_string)
(Fformat_mode_line, syms_of_xdisp):
* xfaces.c (set_font_frame_param)
(Finternal_lisp_face_attribute_values)
(Finternal_merge_in_global_face, syms_of_xfaces):
* xfns.c (x_default_scroll_bar_color_parameter)
(x_default_font_parameter, x_create_tip_frame):
* xfont.c (xfont_supported_scripts):
* xmenu.c (Fx_popup_dialog, xmenu_show, xdialog_show)
(menu_help_callback, xmenu_show):
* xml.c (make_dom):
* xterm.c (set_wm_state):
Prefer list1 (FOO) to Fcons (FOO, Qnil) when creating a list,
and similarly for list2 through list5.
2013-07-15 Paul Eggert <eggert@cs.ucla.edu>
* callproc.c (Fcall_process_region): Fix minor race and tune.
(create_temp_file): New function, with the temp-file-creation part
of the old Fcall_process_region. Use Fcopy_sequence to create the
temp file name, rather than alloca + build_string, for simplicity.
Don't bother to block input around the temp file creation;
shouldn't be needed. Simplify use of mktemp. Use
record_unwind_protect immediately after creating the temp file;
this closes an unlikely race where the temp file was not removed.
Use memcpy rather than an open-coded loop.
(Fcall_process_region): Use the new function. If the input is
empty, redirect from /dev/null rather than from a newly created
empty temp file; this avoids unnecessary file system traffic.
2013-07-14 Paul Eggert <eggert@cs.ucla.edu>
* filelock.c (create_lock_file) [!HAVE_MKOSTEMP && !HAVE_MKSTEMP]:
Simplify by making this case like the other two. This is a bit
slower on obsolete hosts, but the extra complexity isn't worth it.
* callproc.c (child_setup, relocate_fd) [!DOS_NT]:
* process.c (create_process) [!DOS_NT]:
Remove now-unnecessary calls to emacs_close.

125
src/alloc.c
View file

@ -209,7 +209,6 @@ Lisp_Object Qchar_table_extra_slots;
static Lisp_Object Qpost_gc_hook;
static void free_save_value (Lisp_Object);
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
@ -342,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. */
@ -813,22 +812,13 @@ xputenv (char const *string)
memory_full (0);
}
/* Unwind for SAFE_ALLOCA */
Lisp_Object
safe_alloca_unwind (Lisp_Object arg)
{
free_save_value (arg);
return Qnil;
}
/* Return a newly allocated memory block of SIZE bytes, remembering
to free it when unwinding. */
void *
record_xmalloc (size_t size)
{
void *p = xmalloc (size);
record_unwind_protect (safe_alloca_unwind, make_save_pointer (p));
record_unwind_protect_ptr (xfree, p);
return p;
}
@ -3352,67 +3342,88 @@ 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;
}
/* The most common task it to save just one C pointer. */
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;
}
/* Free a Lisp_Save_Value object. Do not use this function
if SAVE contains pointer other than returned by xmalloc. */
static void
void
free_save_value (Lisp_Object save)
{
xfree (XSAVE_POINTER (save, 0));
@ -4741,7 +4752,7 @@ valid_pointer_p (void *p)
Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
not validate p in that case. */
if (pipe2 (fd, O_CLOEXEC) == 0)
if (emacs_pipe (fd) == 0)
{
bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
emacs_close (fd[1]);
@ -5125,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;
}
@ -5227,7 +5238,7 @@ See Info node `(elisp)Garbage Collection'. */)
/* Save what's currently displayed in the echo area. */
message_p = push_message ();
record_unwind_protect (pop_message_unwind, Qnil);
record_unwind_protect_void (pop_message_unwind);
/* Save a copy of the contents of the stack, for debugging. */
#if MAX_SAVE_STACK > 0

12
src/atimer.c
View file

@ -250,7 +250,7 @@ stop_other_atimers (struct atimer *t)
/* Run all timers again, if some have been stopped with a call to
stop_other_atimers. */
static void
void
run_all_atimers (void)
{
if (stopped_atimers)
@ -274,16 +274,6 @@ run_all_atimers (void)
}
/* A version of run_all_atimers suitable for a record_unwind_protect. */
Lisp_Object
unwind_stop_other_atimers (Lisp_Object dummy)
{
run_all_atimers ();
return Qnil;
}
/* Arrange for a SIGALRM to arrive when the next timer is ripe. */
static void

2
src/atimer.h
View file

@ -77,6 +77,6 @@ void do_pending_atimers (void);
void init_atimer (void);
void turn_on_atimers (bool);
void stop_other_atimers (struct atimer *);
Lisp_Object unwind_stop_other_atimers (Lisp_Object);
void run_all_atimers (void);
#endif /* EMACS_ATIMER_H */

13
src/buffer.c
View file

@ -617,7 +617,7 @@ even if it is dead. The return value is never nil. */)
/* Put this in the alist of all live buffers. */
XSETBUFFER (buffer, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil));
Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
/* And run buffer-list-update-hook. */
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, Qbuffer_list_update_hook);
@ -828,7 +828,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
/* Put this in the alist of all live buffers. */
XSETBUFFER (buf, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil));
Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf)));
bset_mark (b, Fmake_marker ());
@ -2215,14 +2215,19 @@ ends when the current command terminates. Use `switch-to-buffer' or
return buffer;
}
void
restore_buffer (Lisp_Object buffer_or_name)
{
Fset_buffer (buffer_or_name);
}
/* Set the current buffer to BUFFER provided if it is alive. */
Lisp_Object
void
set_buffer_if_live (Lisp_Object buffer)
{
if (BUFFER_LIVE_P (XBUFFER (buffer)))
set_buffer_internal (XBUFFER (buffer));
return Qnil;
}
DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,

2
src/buffer.h
View file

@ -1073,6 +1073,8 @@ extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object);
extern void record_buffer (Lisp_Object);
extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t);
extern void mmap_set_vars (bool);
extern void restore_buffer (Lisp_Object);
extern void set_buffer_if_live (Lisp_Object);
/* Set the current buffer to B.

19
src/bytecode.c
View file

@ -572,9 +572,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (nargs < mandatory)
/* Too few arguments. */
Fsignal (Qwrong_number_of_arguments,
Fcons (Fcons (make_number (mandatory),
list2 (Fcons (make_number (mandatory),
rest ? Qand_rest : make_number (nonrest)),
Fcons (make_number (nargs), Qnil)));
make_number (nargs)));
else
{
for (; i < nonrest; i++)
@ -593,9 +593,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
else
/* Too many arguments. */
Fsignal (Qwrong_number_of_arguments,
Fcons (Fcons (make_number (mandatory),
make_number (nonrest)),
Fcons (make_number (nargs), Qnil)));
list2 (Fcons (make_number (mandatory), make_number (nonrest)),
make_number (nargs)));
}
else if (! NILP (args_template))
/* We should push some arguments on the stack. */
@ -1064,8 +1063,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bsave_window_excursion): /* Obsolete since 24.1. */
{
register ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_protect (Fset_window_configuration,
ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (Qnil));
BEFORE_POTENTIAL_GC ();
TOP = Fprogn (TOP);
@ -1090,7 +1089,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
record_unwind_protect (unwind_body, POP);
NEXT;
CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */
@ -1172,14 +1171,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Blist1):
TOP = Fcons (TOP, Qnil);
TOP = list1 (TOP);
NEXT;
CASE (Blist2):
{
Lisp_Object v1;
v1 = POP;
TOP = Fcons (TOP, Fcons (v1, Qnil));
TOP = list2 (TOP, v1);
NEXT;
}

4
src/callint.c
View file

@ -127,7 +127,7 @@ quotify_arg (register Lisp_Object exp)
if (CONSP (exp)
|| (SYMBOLP (exp)
&& !NILP (exp) && !EQ (exp, Qt)))
return Fcons (Qquote, Fcons (exp, Qnil));
return list2 (Qquote, exp);
return exp;
}
@ -802,7 +802,7 @@ invoke it. If KEYS is omitted or nil, the return value of
for (i = 1; i < nargs; i++)
{
if (varies[i] > 0)
visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
else
visargs[i] = quotify_arg (args[i]);
}

281
src/callproc.c
View file

@ -123,8 +123,8 @@ record_kill_process (struct Lisp_Process *p)
/* Clean up when exiting call_process_cleanup. */
static Lisp_Object
call_process_kill (Lisp_Object ignored)
static void
call_process_kill (void)
{
if (synch_process_fd >= 0)
emacs_close (synch_process_fd);
@ -136,15 +136,13 @@ call_process_kill (Lisp_Object ignored)
proc.pid = synch_process_pid;
record_kill_process (&proc);
}
return Qnil;
}
/* Clean up when exiting Fcall_process.
On MSDOS, delete the temporary file on any kind of termination.
On Unix, kill the process and any children on termination by signal. */
static Lisp_Object
static void
call_process_cleanup (Lisp_Object arg)
{
#ifdef MSDOS
@ -162,7 +160,7 @@ call_process_cleanup (Lisp_Object arg)
{
ptrdiff_t count = SPECPDL_INDEX ();
kill (-synch_process_pid, SIGINT);
record_unwind_protect (call_process_kill, make_number (0));
record_unwind_protect_void (call_process_kill);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
immediate_quit = 1;
QUIT;
@ -183,8 +181,6 @@ call_process_cleanup (Lisp_Object arg)
if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
unlink (SDATA (file));
#endif
return Qnil;
}
#ifdef DOS_NT
@ -392,7 +388,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
Fcons (BVAR (current_buffer, directory), Qnil));
BVAR (current_buffer, directory));
if (STRING_MULTIBYTE (infile))
infile = ENCODE_FILE (infile);
@ -409,8 +405,11 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
if (filefd < 0)
report_file_error ("Opening process input file",
Fcons (DECODE_FILE (infile), Qnil));
{
int open_errno = errno;
report_file_errno ("Opening process input file", DECODE_FILE (infile),
open_errno);
}
if (STRINGP (output_file))
{
@ -422,7 +421,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
int open_errno = errno;
output_file = DECODE_FILE (output_file);
report_file_errno ("Opening process output file",
Fcons (output_file, Qnil), open_errno);
output_file, open_errno);
}
if (STRINGP (error_file) || NILP (error_file))
output_to_buffer = 0;
@ -440,8 +439,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
{
int openp_errno = errno;
emacs_close (filefd);
report_file_errno ("Searching for program",
Fcons (args[0], Qnil), openp_errno);
report_file_errno ("Searching for program", args[0], openp_errno);
}
}
@ -506,7 +504,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
int open_errno = errno;
emacs_close (filefd);
report_file_errno ("Opening process output file",
Fcons (build_string (tempfile), Qnil), open_errno);
build_string (tempfile), open_errno);
}
}
else
@ -524,7 +522,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
{
#ifndef MSDOS
int fd[2];
if (pipe2 (fd, O_CLOEXEC) != 0)
if (emacs_pipe (fd) != 0)
{
int pipe_errno = errno;
emacs_close (filefd);
@ -563,8 +561,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
error_file = build_string (NULL_DEVICE);
else if (STRINGP (error_file))
error_file = DECODE_FILE (error_file);
report_file_errno ("Cannot redirect stderr",
Fcons (error_file, Qnil), open_errno);
report_file_errno ("Cannot redirect stderr", error_file, open_errno);
}
#ifdef MSDOS /* MW, July 1993 */
@ -596,8 +593,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
unlink (tempfile);
emacs_close (filefd);
report_file_errno ("Cannot re-open temporary file",
Fcons (build_string (tempfile), Qnil),
open_errno);
build_string (tempfile), open_errno);
}
}
else
@ -935,7 +931,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
return make_number (WEXITSTATUS (status));
}
static Lisp_Object
static void
delete_temp_file (Lisp_Object name)
{
/* Suppress jka-compr handling, etc. */
@ -957,7 +953,120 @@ delete_temp_file (Lisp_Object name)
internal_delete_file (name);
#endif
unbind_to (count, Qnil);
return Qnil;
}
/* Create a temporary file suitable for storing the input data of
call-process-region. NARGS and ARGS are the same as for
call-process-region. */
static Lisp_Object
create_temp_file (ptrdiff_t nargs, Lisp_Object *args)
{
struct gcpro gcpro1;
Lisp_Object filename_string;
Lisp_Object val, start, end;
Lisp_Object tmpdir;
if (STRINGP (Vtemporary_file_directory))
tmpdir = Vtemporary_file_directory;
else
{
char *outf;
#ifndef DOS_NT
outf = getenv ("TMPDIR");
tmpdir = build_string (outf ? outf : "/tmp/");
#else /* DOS_NT */
if ((outf = egetenv ("TMPDIR"))
|| (outf = egetenv ("TMP"))
|| (outf = egetenv ("TEMP")))
tmpdir = build_string (outf);
else
tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
#endif
}
{
Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
char *tempfile;
#ifdef WINDOWSNT
/* Cannot use the result of Fexpand_file_name, because it
downcases the XXXXXX part of the pattern, and mktemp then
doesn't recognize it. */
if (!NILP (Vw32_downcase_file_names))
{
Lisp_Object dirname = Ffile_name_directory (pattern);
if (NILP (dirname))
pattern = Vtemp_file_name_pattern;
else
pattern = concat2 (dirname, Vtemp_file_name_pattern);
}
#endif
filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
GCPRO1 (filename_string);
tempfile = SSDATA (filename_string);
{
int fd;
#ifdef HAVE_MKOSTEMP
fd = mkostemp (tempfile, O_CLOEXEC);
#elif defined HAVE_MKSTEMP
fd = mkstemp (tempfile);
#else
errno = EEXIST;
mktemp (tempfile);
/* INT_MAX denotes success, because close (INT_MAX) does nothing. */
fd = *tempfile ? INT_MAX : -1;
#endif
if (fd < 0)
report_file_error ("Failed to open temporary file using pattern",
pattern);
emacs_close (fd);
}
record_unwind_protect (delete_temp_file, filename_string);
}
start = args[0];
end = args[1];
/* Decide coding-system of the contents of the temporary file. */
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
val = Qraw_text;
else
{
Lisp_Object coding_systems;
Lisp_Object *args2;
USE_SAFE_ALLOCA;
SAFE_NALLOCA (args2, 1, nargs + 1);
args2[0] = Qcall_process_region;
memcpy (args2 + 1, args, nargs * sizeof *args);
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
SAFE_FREE ();
}
val = complement_process_encoding_system (val);
{
ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
happen to get a ".Z" suffix. */
specbind (intern ("file-name-handler-alist"), Qnil);
Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
unbind_to (count1, Qnil);
}
/* Note that Fcall_process takes care of binding
coding-system-for-read. */
RETURN_UNGCPRO (filename_string);
}
DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
@ -988,124 +1097,26 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
(ptrdiff_t nargs, Lisp_Object *args)
{
struct gcpro gcpro1;
Lisp_Object filename_string;
register Lisp_Object start, end;
Lisp_Object infile;
ptrdiff_t count = SPECPDL_INDEX ();
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems;
Lisp_Object val, *args2;
ptrdiff_t i;
Lisp_Object tmpdir;
Lisp_Object start = args[0];
Lisp_Object end = args[1];
bool empty_input;
if (STRINGP (Vtemporary_file_directory))
tmpdir = Vtemporary_file_directory;
if (STRINGP (start))
empty_input = SCHARS (start) == 0;
else if (NILP (start))
empty_input = BEG == Z;
else
{
char *outf;
#ifndef DOS_NT
outf = getenv ("TMPDIR");
tmpdir = build_string (outf ? outf : "/tmp/");
#else /* DOS_NT */
if ((outf = egetenv ("TMPDIR"))
|| (outf = egetenv ("TMP"))
|| (outf = egetenv ("TEMP")))
tmpdir = build_string (outf);
else
tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
#endif
validate_region (&args[0], &args[1]);
start = args[0];
end = args[1];
empty_input = XINT (start) == XINT (end);
}
{
USE_SAFE_ALLOCA;
Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
Lisp_Object encoded_tem;
char *tempfile;
#ifdef WINDOWSNT
/* Cannot use the result of Fexpand_file_name, because it
downcases the XXXXXX part of the pattern, and mktemp then
doesn't recognize it. */
if (!NILP (Vw32_downcase_file_names))
{
Lisp_Object dirname = Ffile_name_directory (pattern);
if (NILP (dirname))
pattern = Vtemp_file_name_pattern;
else
pattern = concat2 (dirname, Vtemp_file_name_pattern);
}
#endif
encoded_tem = ENCODE_FILE (pattern);
tempfile = SAFE_ALLOCA (SBYTES (encoded_tem) + 1);
memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1);
coding_systems = Qt;
#if defined HAVE_MKOSTEMP || defined HAVE_MKSTEMP
{
int fd, open_errno;
block_input ();
# ifdef HAVE_MKOSTEMP
fd = mkostemp (tempfile, O_CLOEXEC);
# else
fd = mkstemp (tempfile);
# endif
open_errno = errno;
unblock_input ();
if (fd < 0)
report_file_errno ("Failed to open temporary file",
Fcons (build_string (tempfile), Qnil), open_errno);
emacs_close (fd);
}
#else
errno = EEXIST;
mktemp (tempfile);
if (!*tempfile)
report_file_error ("Failed to open temporary file using pattern",
Fcons (pattern, Qnil));
#endif
filename_string = build_string (tempfile);
GCPRO1 (filename_string);
SAFE_FREE ();
}
start = args[0];
end = args[1];
/* Decide coding-system of the contents of the temporary file. */
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
val = Qraw_text;
else
{
USE_SAFE_ALLOCA;
SAFE_NALLOCA (args2, 1, nargs + 1);
args2[0] = Qcall_process_region;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
SAFE_FREE ();
}
val = complement_process_encoding_system (val);
{
ptrdiff_t count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
happen to get a ".Z" suffix. */
specbind (intern ("file-name-handler-alist"), Qnil);
Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil);
unbind_to (count1, Qnil);
}
/* Note that Fcall_process takes care of binding
coding-system-for-read. */
record_unwind_protect (delete_temp_file, filename_string);
infile = empty_input ? Qnil : create_temp_file (nargs, args);
GCPRO1 (infile);
if (nargs > 3 && !NILP (args[3]))
Fdelete_region (start, end);
@ -1120,7 +1131,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
args[0] = args[2];
nargs = 2;
}
args[1] = filename_string;
args[1] = infile;
RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args)));
}

43
src/charset.c
View file

@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define CHARSET_INLINE EXTERN_INLINE
#include <errno.h>
#include <stdio.h>
#include <unistd.h>
#include <limits.h>
@ -477,7 +478,8 @@ read_hex (FILE *fp, bool *eof, bool *overflow)
`file-name-handler-alist' to avoid running any Lisp code. */
static void
load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int control_flag)
load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
int control_flag)
{
unsigned min_code = CHARSET_MIN_CODE (charset);
unsigned max_code = CHARSET_MAX_CODE (charset);
@ -487,22 +489,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
struct charset_map_entries *head, *entries;
int n_entries;
ptrdiff_t count;
USE_SAFE_ALLOCA;
suffixes = Fcons (build_string (".map"),
Fcons (build_string (".TXT"), Qnil));
suffixes = list2 (build_string (".map"), build_string (".TXT"));
count = SPECPDL_INDEX ();
record_unwind_protect_nothing ();
specbind (Qfile_name_handler_alist, Qnil);
fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil);
unbind_to (count, Qnil);
if (fd < 0
|| ! (fp = fdopen (fd, "r")))
error ("Failure in loading charset map: %s", SDATA (mapfile));
fp = fd < 0 ? 0 : fdopen (fd, "r");
if (!fp)
{
int open_errno = errno;
emacs_close (fd);
report_file_errno ("Loading charset map", mapfile, open_errno);
}
set_unwind_protect_ptr (count, fclose_unwind, fp);
unbind_to (count + 1, Qnil);
/* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
/* Use record_xmalloc, as `charset_map_entries' is
large (larger than MAX_ALLOCA). */
head = SAFE_ALLOCA (sizeof *head);
head = record_xmalloc (sizeof *head);
entries = head;
memset (entries, 0, sizeof (struct charset_map_entries));
@ -531,9 +537,9 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
continue;
if (n_entries > 0 && (n_entries % 0x10000) == 0)
if (n_entries == 0x10000)
{
entries->next = SAFE_ALLOCA (sizeof *entries->next);
entries->next = record_xmalloc (sizeof *entries->next);
entries = entries->next;
memset (entries, 0, sizeof (struct charset_map_entries));
n_entries = 0;
@ -545,9 +551,10 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co
n_entries++;
}
fclose (fp);
clear_unwind_protect (count);
load_charset_map (charset, head, n_entries, control_flag);
SAFE_FREE ();
unbind_to (count, Qnil);
}
static void
@ -1178,7 +1185,7 @@ usage: (define-charset-internal ...) */)
charset.iso_final) = id;
if (new_definition_p)
Viso_2022_charset_list = nconc2 (Viso_2022_charset_list,
Fcons (make_number (id), Qnil));
list1 (make_number (id)));
if (ISO_CHARSET_TABLE (1, 0, 'J') == id)
charset_jisx0201_roman = id;
else if (ISO_CHARSET_TABLE (2, 0, '@') == id)
@ -1198,7 +1205,7 @@ usage: (define-charset-internal ...) */)
emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2;
if (new_definition_p)
Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list,
Fcons (make_number (id), Qnil));
list1 (make_number (id)));
}
if (new_definition_p)
@ -1206,7 +1213,7 @@ usage: (define-charset-internal ...) */)
Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list);
if (charset.supplementary_p)
Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
Fcons (make_number (id), Qnil));
list1 (make_number (id)));
else
{
Lisp_Object tail;
@ -1223,7 +1230,7 @@ usage: (define-charset-internal ...) */)
Vcharset_ordered_list);
else if (NILP (tail))
Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
Fcons (make_number (id), Qnil));
list1 (make_number (id)));
else
{
val = Fcons (XCAR (tail), XCDR (tail));
@ -2308,7 +2315,7 @@ Please check your installation!\n",
exit (1);
}
Vcharset_map_path = Fcons (tempdir, Qnil);
Vcharset_map_path = list1 (tempdir);
}

80
src/coding.c
View file

@ -1363,6 +1363,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
@ -6864,11 +6903,9 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup)
if (CHAR_TABLE_P (standard))
{
if (CONSP (translation_table))
translation_table = nconc2 (translation_table,
Fcons (standard, Qnil));
translation_table = nconc2 (translation_table, list1 (standard));
else
translation_table = Fcons (translation_table,
Fcons (standard, Qnil));
translation_table = list2 (translation_table, standard);
}
}
@ -7793,7 +7830,7 @@ make_conversion_work_buffer (bool multibyte)
}
static Lisp_Object
static void
code_conversion_restore (Lisp_Object arg)
{
Lisp_Object current, workbuf;
@ -7811,7 +7848,6 @@ code_conversion_restore (Lisp_Object arg)
}
set_buffer_internal (XBUFFER (current));
UNGCPRO;
return Qnil;
}
Lisp_Object
@ -8667,20 +8703,20 @@ detect_coding_system (const unsigned char *src,
{
detect_info.found = CATEGORY_MASK_RAW_TEXT;
id = CODING_SYSTEM_ID (Qno_conversion);
val = Fcons (make_number (id), Qnil);
val = list1 (make_number (id));
}
else if (! detect_info.rejected && ! detect_info.found)
{
detect_info.found = CATEGORY_MASK_ANY;
id = coding_categories[coding_category_undecided].id;
val = Fcons (make_number (id), Qnil);
val = list1 (make_number (id));
}
else if (highest)
{
if (detect_info.found)
{
detect_info.found = 1 << category;
val = Fcons (make_number (this->id), Qnil);
val = list1 (make_number (this->id));
}
else
for (i = 0; i < coding_category_raw_text; i++)
@ -8688,7 +8724,7 @@ detect_coding_system (const unsigned char *src,
{
detect_info.found = 1 << coding_priorities[i];
id = coding_categories[coding_priorities[i]].id;
val = Fcons (make_number (id), Qnil);
val = list1 (make_number (id));
break;
}
}
@ -8705,7 +8741,7 @@ detect_coding_system (const unsigned char *src,
found |= 1 << category;
id = coding_categories[category].id;
if (id >= 0)
val = Fcons (make_number (id), val);
val = list1 (make_number (id));
}
}
for (i = coding_category_raw_text - 1; i >= 0; i--)
@ -8730,7 +8766,7 @@ detect_coding_system (const unsigned char *src,
this = coding_categories + coding_category_utf_8_sig;
else
this = coding_categories + coding_category_utf_8_nosig;
val = Fcons (make_number (this->id), Qnil);
val = list1 (make_number (this->id));
}
}
else if (base_category == coding_category_utf_16_auto)
@ -8747,13 +8783,13 @@ detect_coding_system (const unsigned char *src,
this = coding_categories + coding_category_utf_16_be_nosig;
else
this = coding_categories + coding_category_utf_16_le_nosig;
val = Fcons (make_number (this->id), Qnil);
val = list1 (make_number (this->id));
}
}
else
{
detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs));
val = Fcons (make_number (coding.id), Qnil);
val = list1 (make_number (coding.id));
}
/* Then, detect eol-format if necessary. */
@ -9224,7 +9260,7 @@ is nil. */)
attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
ASET (attrs, coding_attr_trans_tbl,
get_translation_table (attrs, 1, NULL));
list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list);
list = Fcons (list2 (elt, attrs), list);
}
if (STRINGP (start))
@ -9635,7 +9671,7 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern
tset_charset_list
(term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK
? coding_charset_list (terminal_coding)
: Fcons (make_number (charset_ascii), Qnil)));
: list1 (make_number (charset_ascii))));
return Qnil;
}
@ -10080,9 +10116,9 @@ usage: (define-coding-system-internal ...) */)
{
dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
if (dim < dim2)
tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil));
tmp = list2 (XCAR (tail), tmp);
else
tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil));
tmp = list2 (tmp, XCAR (tail));
}
else
{
@ -10093,7 +10129,7 @@ usage: (define-coding-system-internal ...) */)
break;
}
if (NILP (tmp2))
tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil));
tmp = nconc2 (tmp, list1 (XCAR (tail)));
else
{
XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
@ -10411,7 +10447,7 @@ usage: (define-coding-system-internal ...) */)
&& ! EQ (eol_type, Qmac))
error ("Invalid eol-type");
aliases = Fcons (name, Qnil);
aliases = list1 (name);
if (NILP (eol_type))
{
@ -10421,7 +10457,7 @@ usage: (define-coding-system-internal ...) */)
Lisp_Object this_spec, this_name, this_aliases, this_eol_type;
this_name = AREF (eol_type, i);
this_aliases = Fcons (this_name, Qnil);
this_aliases = list1 (this_name);
this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
this_spec = make_uninit_vector (3);
ASET (this_spec, 0, attrs);
@ -10536,7 +10572,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
list. */
while (!NILP (XCDR (aliases)))
aliases = XCDR (aliases);
XSETCDR (aliases, Fcons (alias, Qnil));
XSETCDR (aliases, list1 (alias));
eol_type = AREF (spec, 2);
if (VECTORP (eol_type))

13
src/composite.c
View file

@ -595,7 +595,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
specbind (Qinhibit_point_motion_hooks, Qt);
Fremove_list_of_text_properties (make_number (min_pos),
make_number (max_pos),
Fcons (Qauto_composed, Qnil), Qnil);
list1 (Qauto_composed), Qnil);
unbind_to (count, Qnil);
}
}
@ -1873,11 +1873,9 @@ See `find-composition' for more details. */)
return list3 (make_number (s), make_number (e), gstring);
}
if (!COMPOSITION_VALID_P (start, end, prop))
return Fcons (make_number (start), Fcons (make_number (end),
Fcons (Qnil, Qnil)));
return list3 (make_number (start), make_number (end), Qnil);
if (NILP (detail_p))
return Fcons (make_number (start), Fcons (make_number (end),
Fcons (Qt, Qnil)));
return list3 (make_number (start), make_number (end), Qt);
if (COMPOSITION_REGISTERD_P (prop))
id = COMPOSITION_ID (prop);
@ -1899,10 +1897,7 @@ See `find-composition' for more details. */)
relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
? Qnil : Qt);
mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
tail = Fcons (components,
Fcons (relative_p,
Fcons (mod_func,
Fcons (make_number (width), Qnil))));
tail = list4 (components, relative_p, mod_func, make_number (width));
}
else
tail = Qnil;

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>

11
src/cygw32.c
View file

@ -23,12 +23,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <fcntl.h>
static Lisp_Object
fchdir_unwind (Lisp_Object dir_fd)
static void
fchdir_unwind (int dir_fd)
{
(void) fchdir (XFASTINT (dir_fd));
(void) close (XFASTINT (dir_fd));
return Qnil;
(void) fchdir (dir_fd);
(void) close (dir_fd);
}
static void
@ -40,7 +39,7 @@ chdir_to_default_directory ()
if (old_cwd_fd == -1)
error ("could not open current directory: %s", strerror (errno));
record_unwind_protect (fchdir_unwind, make_number (old_cwd_fd));
record_unwind_protect_int (fchdir_unwind, old_cwd_fd);
new_cwd = Funhandled_file_name_directory (
Fexpand_file_name (build_string ("."), Qnil));

22
src/dired.c
View file

@ -107,22 +107,20 @@ open_directory (char const *name, int *fdp)
}
#ifdef WINDOWSNT
Lisp_Object
void
directory_files_internal_w32_unwind (Lisp_Object arg)
{
Vw32_get_true_file_attributes = arg;
return Qnil;
}
#endif
static Lisp_Object
directory_files_internal_unwind (Lisp_Object dh)
static void
directory_files_internal_unwind (void *dh)
{
DIR *d = XSAVE_POINTER (dh, 0);
DIR *d = dh;
block_input ();
closedir (d);
unblock_input ();
return Qnil;
}
/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
@ -185,13 +183,12 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
d = open_directory (SSDATA (dirfilename), &fd);
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
report_file_error ("Opening directory", directory);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect (directory_files_internal_unwind,
make_save_pointer (d));
record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
if (attrs)
@ -488,10 +485,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
d = open_directory (SSDATA (encoded_dir), &fd);
if (!d)
report_file_error ("Opening directory", Fcons (dirname, Qnil));
report_file_error ("Opening directory", dirname);
record_unwind_protect (directory_files_internal_unwind,
make_save_pointer (d));
record_unwind_protect_ptr (directory_files_internal_unwind, d);
/* Loop reading blocks */
/* (att3b compiler bug requires do a null comparison this way) */
@ -1017,7 +1013,7 @@ return a list with one element, taken from `user-real-login-name'. */)
#endif
if (EQ (users, Qnil))
/* At least current user is always known. */
users = Fcons (Vuser_real_login_name, Qnil);
users = list1 (Vuser_real_login_name);
return users;
}

17
src/dispnew.c
View file

@ -5630,7 +5630,7 @@ FILE = nil means just close any termscript file currently open. */)
file = Fexpand_file_name (file, Qnil);
tty->termscript = emacs_fopen (SSDATA (file), "w");
if (tty->termscript == 0)
report_file_error ("Opening termscript", Fcons (file, Qnil));
report_file_error ("Opening termscript", file);
}
return Qnil;
}
@ -5710,7 +5710,7 @@ bitch_at_user (void)
{
const char *msg
= "Keyboard macro terminated by a command ringing the bell";
Fsignal (Quser_error, Fcons (build_string (msg), Qnil));
Fsignal (Quser_error, list1 (build_string (msg)));
}
else
ring_bell (XFRAME (selected_frame));
@ -6138,15 +6138,14 @@ init_display (void)
/* Update frame parameters to reflect the new type. */
Fmodify_frame_parameters
(selected_frame, Fcons (Fcons (Qtty_type,
Ftty_type (selected_frame)), Qnil));
(selected_frame, list1 (Fcons (Qtty_type,
Ftty_type (selected_frame))));
if (t->display_info.tty->name)
Fmodify_frame_parameters (selected_frame,
Fcons (Fcons (Qtty, build_string (t->display_info.tty->name)),
Qnil));
Fmodify_frame_parameters
(selected_frame,
list1 (Fcons (Qtty, build_string (t->display_info.tty->name))));
else
Fmodify_frame_parameters (selected_frame, Fcons (Fcons (Qtty, Qnil),
Qnil));
Fmodify_frame_parameters (selected_frame, list1 (Fcons (Qtty, Qnil)));
}
{

41
src/doc.c
View file

@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/file.h> /* Must be after sys/types.h for USG. */
#include <fcntl.h>
@ -84,6 +85,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
int offset;
EMACS_INT position;
Lisp_Object file, tem, pos;
ptrdiff_t count;
USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
@ -143,9 +145,14 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
}
#endif
if (fd < 0)
return concat3 (build_string ("Cannot open doc string file \""),
file, build_string ("\"\n"));
{
SAFE_FREE ();
return concat3 (build_string ("Cannot open doc string file \""),
file, build_string ("\"\n"));
}
}
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
@ -153,13 +160,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
{
emacs_close (fd);
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
SAFE_FREE ();
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
@ -189,10 +191,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
{
emacs_close (fd);
error ("Read error on documentation file");
}
report_file_error ("Read error on documentation file", file);
p[nread] = 0;
if (!nread)
break;
@ -208,7 +207,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
}
p += nread;
}
emacs_close (fd);
unbind_to (count, Qnil);
SAFE_FREE ();
/* Sanity checking. */
if (CONSP (filepos))
@ -573,6 +573,7 @@ the same file name is found in the `doc-directory'. */)
Lisp_Object sym;
char *p, *name;
bool skip_file = 0;
ptrdiff_t count;
CHECK_STRING (filename);
@ -609,8 +610,13 @@ the same file name is found in the `doc-directory'. */)
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
report_file_error ("Opening doc string file",
Fcons (build_string (name), Qnil));
{
int open_errno = errno;
report_file_errno ("Opening doc string file", build_string (name),
open_errno);
}
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
Vdoc_file_name = filename;
filled = 0;
pos = 0;
@ -688,8 +694,7 @@ the same file name is found in the `doc-directory'. */)
filled -= end - buf;
memmove (buf, end, filled);
}
emacs_close (fd);
return Qnil;
return unbind_to (count, Qnil);
}
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,

28
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)
@ -853,7 +852,7 @@ save_excursion_save (void)
/* Restore saved buffer before leaving `save-excursion' special form. */
Lisp_Object
void
save_excursion_restore (Lisp_Object info)
{
Lisp_Object tem, tem1, omark, nmark;
@ -927,7 +926,6 @@ save_excursion_restore (Lisp_Object info)
out:
free_misc (info);
return Qnil;
}
DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
@ -2809,18 +2807,16 @@ determines whether case is significant or ignored. */)
return make_number (0);
}
static Lisp_Object
static void
subst_char_in_region_unwind (Lisp_Object arg)
{
bset_undo_list (current_buffer, arg);
return arg;
}
static Lisp_Object
static void
subst_char_in_region_unwind_1 (Lisp_Object arg)
{
bset_filename (current_buffer, arg);
return arg;
}
DEFUN ("subst-char-in-region", Fsubst_char_in_region,
@ -3331,7 +3327,7 @@ save_restriction_save (void)
}
}
Lisp_Object
void
save_restriction_restore (Lisp_Object data)
{
struct buffer *cur = NULL;
@ -3398,8 +3394,6 @@ save_restriction_restore (Lisp_Object data)
if (cur)
set_buffer_internal (cur);
return Qnil;
}
DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
@ -3492,7 +3486,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
{
Lisp_Object pane, menu;
struct gcpro gcpro1;
pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
pane = list1 (Fcons (build_string ("OK"), Qt));
GCPRO1 (pane);
menu = Fcons (val, pane);
Fx_popup_dialog (Qt, menu, Qt);
@ -3627,7 +3621,7 @@ usage: (format STRING &rest OBJECTS) */)
ptrdiff_t bufsize = sizeof initial_buffer;
ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
char *p;
Lisp_Object buf_save_value IF_LINT (= {0});
ptrdiff_t buf_save_value_index IF_LINT (= 0);
char *format, *end, *format_start;
ptrdiff_t formatlen, nchars;
/* True if the format is multibyte. */
@ -4236,14 +4230,14 @@ usage: (format STRING &rest OBJECTS) */)
{
buf = xmalloc (bufsize);
sa_must_free = 1;
buf_save_value = make_save_pointer (buf);
record_unwind_protect (safe_alloca_unwind, buf_save_value);
buf_save_value_index = SPECPDL_INDEX ();
record_unwind_protect_ptr (xfree, buf);
memcpy (buf, initial_buffer, used);
}
else
{
buf = xrealloc (buf, bufsize);
set_save_pointer (buf_save_value, 0, buf);
set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
}
p = buf + used;

9
src/emacs.c
View file

@ -988,7 +988,7 @@ main (int argc, char **argv)
use a pipe for synchronization. The parent waits for the child
to close its end of the pipe (using `daemon-initialized')
before exiting. */
if (pipe2 (daemon_pipe, O_CLOEXEC) != 0)
if (emacs_pipe (daemon_pipe) != 0)
{
fprintf (stderr, "Cannot pipe!\n");
exit (1);
@ -1508,12 +1508,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
char *file;
/* Handle -l loadup, args passed by Makefile. */
if (argmatch (argv, argc, "-l", "--load", 3, &file, &skip_args))
Vtop_level = Fcons (intern_c_string ("load"),
Fcons (build_string (file), Qnil));
Vtop_level = list2 (intern_c_string ("load"), build_string (file));
/* Unless next switch is -nl, load "loadup.el" first thing. */
if (! no_loadup)
Vtop_level = Fcons (intern_c_string ("load"),
Fcons (build_string ("loadup.el"), Qnil));
Vtop_level = list2 (intern_c_string ("load"),
build_string ("loadup.el"));
}
if (initialized)

133
src/eval.c
View file

@ -152,13 +152,6 @@ specpdl_arg (union specbinding *pdl)
return pdl->unwind.arg;
}
static specbinding_func
specpdl_func (union specbinding *pdl)
{
eassert (pdl->kind == SPECPDL_UNWIND);
return pdl->unwind.func;
}
Lisp_Object
backtrace_function (union specbinding *pdl)
{
@ -267,12 +260,11 @@ init_eval (void)
/* Unwind-protect function used by call_debugger. */
static Lisp_Object
static void
restore_stack_limits (Lisp_Object data)
{
max_specpdl_size = XINT (XCAR (data));
max_lisp_eval_depth = XINT (XCDR (data));
return Qnil;
}
/* Call the Lisp debugger, giving it argument ARG. */
@ -338,7 +330,7 @@ do_debug_on_call (Lisp_Object code)
{
debug_on_next_call = 0;
set_backtrace_debug_on_exit (specpdl_ptr - 1, true);
call_debugger (Fcons (code, Qnil));
call_debugger (list1 (code));
}
/* NOTE!!! Every function that can call EVAL must protect its args
@ -450,23 +442,32 @@ usage: (cond CLAUSES...) */)
DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY...) */)
(Lisp_Object args)
(Lisp_Object body)
{
register Lisp_Object val = Qnil;
Lisp_Object val = Qnil;
struct gcpro gcpro1;
GCPRO1 (args);
GCPRO1 (body);
while (CONSP (args))
while (CONSP (body))
{
val = eval_sub (XCAR (args));
args = XCDR (args);
val = eval_sub (XCAR (body));
body = XCDR (body);
}
UNGCPRO;
return val;
}
/* Evaluate BODY sequentually, discarding its value. Suitable for
record_unwind_protect. */
void
unwind_body (Lisp_Object body)
{
Fprogn (body);
}
DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
The value of FIRST is saved during the evaluation of the remaining args,
@ -1149,7 +1150,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
record_unwind_protect (unwind_body, Fcdr (args));
val = eval_sub (Fcar (args));
return unbind_to (count, val);
}
@ -1611,7 +1612,7 @@ signal_error (const char *s, Lisp_Object arg)
}
if (!NILP (hare))
arg = Fcons (arg, Qnil); /* Make it a list. */
arg = list1 (arg);
xsignal (Qerror, Fcons (build_string (s), arg));
}
@ -1703,7 +1704,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
/* RMS: What's this for? */
&& when_entered_debugger < num_nonmacro_input_events)
{
call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
call_debugger (list2 (Qerror, combined_data));
return 1;
}
@ -1890,10 +1891,10 @@ this does nothing and returns nil. */)
Qnil);
}
Lisp_Object
void
un_autoload (Lisp_Object oldqueue)
{
register Lisp_Object queue, first, second;
Lisp_Object queue, first, second;
/* Queue to unwind is current value of Vautoload_queue.
oldqueue is the shadowed value to leave in Vautoload_queue. */
@ -1910,7 +1911,6 @@ un_autoload (Lisp_Object oldqueue)
Ffset (first, second);
queue = XCDR (queue);
}
return Qnil;
}
/* Load an autoloaded function.
@ -1992,7 +1992,7 @@ If LEXICAL is t, evaluate using lexical scoping. */)
{
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment,
CONSP (lexical) || NILP (lexical) ? lexical : Fcons (Qt, Qnil));
CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt));
return unbind_to (count, eval_sub (form));
}
@ -2257,7 +2257,7 @@ eval_sub (Lisp_Object form)
lisp_eval_depth--;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
val = call_debugger (list2 (Qexit, val));
specpdl_ptr--;
return val;
@ -2878,7 +2878,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
check_cons_list ();
lisp_eval_depth--;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
val = call_debugger (list2 (Qexit, val));
specpdl_ptr--;
return val;
}
@ -2920,7 +2920,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
{
/* Don't do it again when we return to eval. */
set_backtrace_debug_on_exit (specpdl_ptr - 1, false);
tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
tem = call_debugger (list2 (Qexit, tem));
}
SAFE_FREE ();
return tem;
@ -3190,8 +3190,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
}
}
/* Push unwind-protect entries of various types. */
void
record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
{
specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
specpdl_ptr->unwind.func = function;
@ -3199,6 +3201,72 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
grow_specpdl ();
}
void
record_unwind_protect_ptr (void (*function) (void *), void *arg)
{
specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
specpdl_ptr->unwind_ptr.func = function;
specpdl_ptr->unwind_ptr.arg = arg;
grow_specpdl ();
}
void
record_unwind_protect_int (void (*function) (int), int arg)
{
specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT;
specpdl_ptr->unwind_int.func = function;
specpdl_ptr->unwind_int.arg = arg;
grow_specpdl ();
}
void
record_unwind_protect_void (void (*function) (void))
{
specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
specpdl_ptr->unwind_void.func = function;
grow_specpdl ();
}
static void
do_nothing (void)
{}
/* Push an unwind-protect entry that does nothing, so that
set_unwind_protect_ptr can overwrite it later. */
void
record_unwind_protect_nothing (void)
{
record_unwind_protect_void (do_nothing);
}
/* Clear the unwind-protect entry COUNT, so that it does nothing.
It need not be at the top of the stack. */
void
clear_unwind_protect (ptrdiff_t count)
{
union specbinding *p = specpdl + count;
p->unwind_void.kind = SPECPDL_UNWIND_VOID;
p->unwind_void.func = do_nothing;
}
/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG).
It need not be at the top of the stack. Discard the entry's
previous value without invoking it. */
void
set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg)
{
union specbinding *p = specpdl + count;
p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
p->unwind_ptr.func = func;
p->unwind_ptr.arg = arg;
}
/* Pop and execute entries from the unwind-protect stack until the
depth COUNT is reached. Return VALUE. */
Lisp_Object
unbind_to (ptrdiff_t count, Lisp_Object value)
{
@ -3220,7 +3288,16 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
switch (specpdl_ptr->kind)
{
case SPECPDL_UNWIND:
specpdl_func (specpdl_ptr) (specpdl_arg (specpdl_ptr));
specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg);
break;
case SPECPDL_UNWIND_PTR:
specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg);
break;
case SPECPDL_UNWIND_INT:
specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg);
break;
case SPECPDL_UNWIND_VOID:
specpdl_ptr->unwind_void.func ();
break;
case SPECPDL_LET:
/* If variable has a trivial value (no forwarding), we can

227
src/fileio.c
View file

@ -160,11 +160,16 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
/* Signal a file-access failure. STRING describes the failure,
DATA the file that was involved, and ERRORNO the errno value. */
NAME the file involved, and ERRORNO the errno value.
If NAME is neither null nor a pair, package it up as a singleton
list before reporting it; this saves report_file_errno's caller the
trouble of preserving errno before calling list1. */
void
report_file_errno (char const *string, Lisp_Object data, int errorno)
report_file_errno (char const *string, Lisp_Object name, int errorno)
{
Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Lisp_Object errstring;
char *str;
@ -198,27 +203,37 @@ report_file_errno (char const *string, Lisp_Object data, int errorno)
}
}
/* Signal a file-access failure that set errno. STRING describes the
failure, NAME the file involved. When invoking this function, take
care to not use arguments such as build_string ("foo") that involve
side effects that may set errno. */
void
report_file_error (char const *string, Lisp_Object data)
report_file_error (char const *string, Lisp_Object name)
{
report_file_errno (string, data, errno);
report_file_errno (string, name, errno);
}
Lisp_Object
close_file_unwind (Lisp_Object fd)
void
close_file_unwind (int fd)
{
emacs_close (XFASTINT (fd));
return Qnil;
emacs_close (fd);
}
void
fclose_unwind (void *arg)
{
FILE *stream = arg;
fclose (stream);
}
/* Restore point, having saved it as a marker. */
Lisp_Object
void
restore_point_unwind (Lisp_Object location)
{
Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
return Qnil;
}
@ -749,7 +764,7 @@ make_temp_name (Lisp_Object prefix, bool base64_p)
dog-slow, but also useless since eventually nil would
have to be returned anyway. */
report_file_error ("Cannot create temporary name for prefix",
Fcons (prefix, Qnil));
prefix);
/* not reached */
}
}
@ -2019,7 +2034,7 @@ entries (depending on how Emacs was built). */)
{
acl = acl_get_file (SDATA (encoded_file), ACL_TYPE_ACCESS);
if (acl == NULL && acl_errno_valid (errno))
report_file_error ("Getting ACL", Fcons (file, Qnil));
report_file_error ("Getting ACL", file);
}
if (!CopyFile (SDATA (encoded_file),
SDATA (encoded_newname),
@ -2027,7 +2042,7 @@ entries (depending on how Emacs was built). */)
{
/* CopyFile doesn't set errno when it fails. By far the most
"popular" reason is that the target is read-only. */
report_file_errno ("Copying file", Fcons (file, Fcons (newname, Qnil)),
report_file_errno ("Copying file", list2 (file, newname),
GetLastError () == 5 ? EACCES : EPERM);
}
/* CopyFile retains the timestamp by default. */
@ -2058,7 +2073,7 @@ entries (depending on how Emacs was built). */)
bool fail =
acl_set_file (SDATA (encoded_newname), ACL_TYPE_ACCESS, acl) != 0;
if (fail && acl_errno_valid (errno))
report_file_error ("Setting ACL", Fcons (newname, Qnil));
report_file_error ("Setting ACL", newname);
acl_free (acl);
}
@ -2068,12 +2083,12 @@ entries (depending on how Emacs was built). */)
immediate_quit = 0;
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
report_file_error ("Opening input file", file);
record_unwind_protect (close_file_unwind, make_number (ifd));
record_unwind_protect_int (close_file_unwind, ifd);
if (fstat (ifd, &st) != 0)
report_file_error ("Input file status", Fcons (file, Qnil));
report_file_error ("Input file status", file);
if (!NILP (preserve_extended_attributes))
{
@ -2082,7 +2097,7 @@ entries (depending on how Emacs was built). */)
{
conlength = fgetfilecon (ifd, &con);
if (conlength == -1)
report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
report_file_error ("Doing fgetfilecon", file);
}
#endif
}
@ -2090,11 +2105,11 @@ entries (depending on how Emacs was built). */)
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
report_file_errno ("Input and output files are the same",
Fcons (file, Fcons (newname, Qnil)), 0);
list2 (file, newname), 0);
/* We can copy only regular files. */
if (!S_ISREG (st.st_mode))
report_file_errno ("Non-regular file", Fcons (file, Qnil),
report_file_errno ("Non-regular file", file,
S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
{
@ -2109,15 +2124,15 @@ entries (depending on how Emacs was built). */)
new_mask);
}
if (ofd < 0)
report_file_error ("Opening output file", Fcons (newname, Qnil));
report_file_error ("Opening output file", newname);
record_unwind_protect (close_file_unwind, make_number (ofd));
record_unwind_protect_int (close_file_unwind, ofd);
immediate_quit = 1;
QUIT;
while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
if (emacs_write_sig (ofd, buf, n) != n)
report_file_error ("I/O error", Fcons (newname, Qnil));
report_file_error ("Write error", newname);
immediate_quit = 0;
#ifndef MSDOS
@ -2145,8 +2160,8 @@ entries (depending on how Emacs was built). */)
st.st_mode & mode_mask)
: fchmod (ofd, st.st_mode & mode_mask))
{
case -2: report_file_error ("Copying permissions from", list1 (file));
case -1: report_file_error ("Copying permissions to", list1 (newname));
case -2: report_file_error ("Copying permissions from", file);
case -1: report_file_error ("Copying permissions to", newname);
}
}
#endif /* not MSDOS */
@ -2158,7 +2173,7 @@ entries (depending on how Emacs was built). */)
bool fail = fsetfilecon (ofd, con) != 0;
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
report_file_error ("Doing fsetfilecon", newname);
freecon (con);
}
@ -2174,7 +2189,7 @@ entries (depending on how Emacs was built). */)
}
if (emacs_close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
report_file_error ("Write error", newname);
emacs_close (ifd);
@ -2220,7 +2235,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal,
#else
if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
#endif
report_file_error ("Creating directory", list1 (directory));
report_file_error ("Creating directory", directory);
return Qnil;
}
@ -2239,7 +2254,7 @@ DEFUN ("delete-directory-internal", Fdelete_directory_internal,
dir = SSDATA (encoded_dir);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", list1 (directory));
report_file_error ("Removing directory", directory);
return Qnil;
}
@ -2282,7 +2297,7 @@ With a prefix argument, TRASH is nil. */)
encoded_file = ENCODE_FILE (filename);
if (unlink (SSDATA (encoded_file)) < 0)
report_file_error ("Removing old name", list1 (filename));
report_file_error ("Removing old name", filename);
return Qnil;
}
@ -2364,7 +2379,8 @@ This is what happens in interactive use with M-x. */)
INTEGERP (ok_if_already_exists), 0, 0);
if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
{
if (errno == EXDEV)
int rename_errno = errno;
if (rename_errno == EXDEV)
{
ptrdiff_t count;
symlink_target = Ffile_symlink_p (file);
@ -2390,7 +2406,7 @@ This is what happens in interactive use with M-x. */)
unbind_to (count, Qnil);
}
else
report_file_error ("Renaming", list2 (file, newname));
report_file_errno ("Renaming", list2 (file, newname), rename_errno);
}
UNGCPRO;
return Qnil;
@ -2444,7 +2460,10 @@ This is what happens in interactive use with M-x. */)
unlink (SSDATA (newname));
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
report_file_error ("Adding new name", list2 (file, newname));
{
int link_errno = errno;
report_file_errno ("Adding new name", list2 (file, newname), link_errno);
}
UNGCPRO;
return Qnil;
@ -2503,6 +2522,7 @@ This happens for interactive use with M-x. */)
if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0)
{
/* If we didn't complain already, silently delete existing file. */
int symlink_errno;
if (errno == EEXIST)
{
unlink (SSDATA (encoded_linkname));
@ -2520,7 +2540,9 @@ This happens for interactive use with M-x. */)
build_string ("Symbolic links are not supported"));
}
report_file_error ("Making symbolic link", list2 (filename, linkname));
symlink_errno = errno;
report_file_errno ("Making symbolic link", list2 (filename, linkname),
symlink_errno);
}
UNGCPRO;
return Qnil;
@ -2719,7 +2741,7 @@ If there is no error, returns nil. */)
encoded_filename = ENCODE_FILE (absname);
if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
report_file_error (SSDATA (string), Fcons (filename, Qnil));
report_file_error (SSDATA (string), filename);
return Qnil;
}
@ -3054,14 +3076,14 @@ or if Emacs was not compiled with SELinux support. */)
!= 0);
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
report_file_error ("Doing lsetfilecon", absname);
context_free (parsed_con);
freecon (con);
return fail ? Qnil : Qt;
}
else
report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil));
report_file_error ("Doing lgetfilecon", absname);
}
#endif
@ -3151,7 +3173,7 @@ support. */)
acl = acl_from_text (SSDATA (acl_string));
if (acl == NULL)
{
report_file_error ("Converting ACL", Fcons (absname, Qnil));
report_file_error ("Converting ACL", absname);
return Qnil;
}
@ -3161,7 +3183,7 @@ support. */)
acl)
!= 0);
if (fail && acl_errno_valid (errno))
report_file_error ("Setting ACL", Fcons (absname, Qnil));
report_file_error ("Setting ACL", absname);
acl_free (acl);
return fail ? Qnil : Qt;
@ -3221,7 +3243,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
encoded_absname = ENCODE_FILE (absname);
if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
report_file_error ("Doing chmod", absname);
return Qnil;
}
@ -3287,7 +3309,7 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
if (file_directory_p (SSDATA (encoded_absname)))
return Qnil;
#endif
report_file_error ("Setting file times", Fcons (absname, Qnil));
report_file_error ("Setting file times", absname);
}
}
@ -3369,7 +3391,7 @@ verify (READ_BUF_SIZE <= INT_MAX);
o remove all text properties.
o set back the buffer multibyteness. */
static Lisp_Object
static void
decide_coding_unwind (Lisp_Object unwind_data)
{
Lisp_Object multibyte, undo_list, buffer;
@ -3388,8 +3410,6 @@ decide_coding_unwind (Lisp_Object unwind_data)
/* Now we are safe to change the buffer's multibyteness directly. */
bset_enable_multibyte_characters (current_buffer, multibyte);
bset_undo_list (current_buffer, undo_list);
return Qnil;
}
/* Read from a non-regular file. STATE is a Lisp_Save_Value
@ -3510,7 +3530,7 @@ by calling `format-decode', which see. */)
&& BEG == Z);
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
bool we_locked_file = 0;
bool deferred_remove_unwind_protect = 0;
ptrdiff_t fd_index;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
@ -3553,7 +3573,7 @@ by calling `format-decode', which see. */)
{
save_errno = errno;
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
report_file_error ("Opening input file", orig_filename);
mtime = time_error_value (save_errno);
st.st_size = -1;
if (!NILP (Vcoding_system_for_read))
@ -3561,14 +3581,15 @@ by calling `format-decode', which see. */)
goto notfound;
}
fd_index = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
/* Replacement should preserve point as it preserves markers. */
if (!NILP (replace))
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
record_unwind_protect (close_file_unwind, make_number (fd));
if (fstat (fd, &st) != 0)
report_file_error ("Input file status", Fcons (orig_filename, Qnil));
report_file_error ("Input file status", orig_filename);
mtime = get_stat_mtime (&st);
/* This code will need to be changed in order to work on named
@ -3682,15 +3703,14 @@ by calling `format-decode', which see. */)
int ntail;
if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
orig_filename);
ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
nread = ntail < 0 ? ntail : nread + ntail;
}
}
if (nread < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
report_file_error ("Read error", orig_filename);
else if (nread > 0)
{
struct buffer *prev = current_buffer;
@ -3726,8 +3746,7 @@ by calling `format-decode', which see. */)
/* Rewind the file for the actual read done later. */
if (lseek (fd, 0, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
report_file_error ("Setting file position", orig_filename);
}
}
@ -3793,8 +3812,7 @@ by calling `format-decode', which see. */)
if (beg_offset != 0)
{
if (lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
report_file_error ("Setting file position", orig_filename);
}
immediate_quit = 1;
@ -3807,8 +3825,7 @@ by calling `format-decode', which see. */)
nread = emacs_read (fd, read_buf, sizeof read_buf);
if (nread < 0)
error ("IO error reading %s: %s",
SSDATA (orig_filename), emacs_strerror (errno));
report_file_error ("Read error", orig_filename);
else if (nread == 0)
break;
@ -3866,16 +3883,14 @@ by calling `format-decode', which see. */)
/* How much can we scan in the next step? */
trial = min (curpos, sizeof read_buf);
if (lseek (fd, curpos - trial, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
report_file_error ("Setting file position", orig_filename);
total_read = nread = 0;
while (total_read < trial)
{
nread = emacs_read (fd, read_buf + total_read, trial - total_read);
if (nread < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
report_file_error ("Read error", orig_filename);
else if (nread == 0)
break;
total_read += nread;
@ -3987,8 +4002,7 @@ by calling `format-decode', which see. */)
CONVERSION_BUFFER. */
if (lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
report_file_error ("Setting file position", orig_filename);
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
unprocessed = 0; /* Bytes not processed in previous loop. */
@ -4018,16 +4032,10 @@ by calling `format-decode', which see. */)
memcpy (read_buf, coding.carryover, unprocessed);
}
UNGCPRO;
emacs_close (fd);
/* We should remove the unwind_protect calling
close_file_unwind, but other stuff has been added the stack,
so defer the removal till we reach the `handled' label. */
deferred_remove_unwind_protect = 1;
if (this < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
report_file_error ("Read error", orig_filename);
emacs_close (fd);
clear_unwind_protect (fd_index);
if (unprocessed > 0)
{
@ -4168,8 +4176,7 @@ by calling `format-decode', which see. */)
if (beg_offset != 0 || !NILP (replace))
{
if (lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
report_file_error ("Setting file position", orig_filename);
}
/* In the following loop, HOW_MUCH contains the total bytes read so
@ -4208,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))
@ -4269,13 +4275,10 @@ by calling `format-decode', which see. */)
Vdeactivate_mark = Qt;
emacs_close (fd);
/* Discard the unwind protect for closing the file. */
specpdl_ptr--;
clear_unwind_protect (fd_index);
if (how_much < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
report_file_error ("Read error", orig_filename);
/* Make the text read part of the buffer. */
GAP_SIZE -= inserted;
@ -4399,11 +4402,6 @@ by calling `format-decode', which see. */)
handled:
if (deferred_remove_unwind_protect)
/* If requested above, discard the unwind protect for closing the
file. */
specpdl_ptr--;
if (!NILP (visit))
{
if (empty_undo_list_p)
@ -4574,8 +4572,7 @@ by calling `format-decode', which see. */)
&& EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
{
/* If visiting nonexistent file, return nil. */
report_file_errno ("Opening input file", Fcons (orig_filename, Qnil),
save_errno);
report_file_errno ("Opening input file", orig_filename, save_errno);
}
if (read_quit)
@ -4590,11 +4587,10 @@ by calling `format-decode', which see. */)
static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
static Lisp_Object
static void
build_annotations_unwind (Lisp_Object arg)
{
Vwrite_region_annotation_buffers = arg;
return Qnil;
}
/* Decide the coding-system to encode the data with. */
@ -4631,7 +4627,7 @@ This function is for internal use only. It may prompt the user. */ )
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
/* Confirm that VAL can surely encode the current region. */
val = call5 (Vselect_safe_coding_system_function,
start, end, Fcons (Qt, Fcons (val, Qnil)),
start, end, list2 (Qt, val),
Qnil, filename);
}
else
@ -4834,7 +4830,7 @@ This calls `write-region-annotate-functions' at the start, and
record_unwind_protect (build_annotations_unwind,
Vwrite_region_annotation_buffers);
Vwrite_region_annotation_buffers = Fcons (Fcurrent_buffer (), Qnil);
Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
@ -4901,11 +4897,10 @@ This calls `write-region-annotate-functions' at the start, and
if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
UNGCPRO;
report_file_errno ("Opening output file", Fcons (filename, Qnil),
open_errno);
report_file_errno ("Opening output file", filename, open_errno);
}
record_unwind_protect (close_file_unwind, make_number (desc));
record_unwind_protect_int (close_file_unwind, desc);
if (NUMBERP (append))
{
@ -4917,8 +4912,7 @@ This calls `write-region-annotate-functions' at the start, and
if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
UNGCPRO;
report_file_errno ("Lseek error", Fcons (filename, Qnil),
lseek_errno);
report_file_errno ("Lseek error", filename, lseek_errno);
}
}
@ -5071,8 +5065,7 @@ This calls `write-region-annotate-functions' at the start, and
}
if (! ok)
error ("IO error writing %s: %s", SDATA (filename),
emacs_strerror (save_errno));
report_file_errno ("Write error", filename, save_errno);
if (visiting)
{
@ -5498,11 +5491,18 @@ auto_save_1 (void)
Qnil, Qnil);
}
static Lisp_Object
do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
struct auto_save_unwind
{
FILE *stream = XSAVE_POINTER (arg, 0);
FILE *stream;
bool auto_raise;
};
static void
do_auto_save_unwind (void *arg)
{
struct auto_save_unwind *p = arg;
FILE *stream = p->stream;
minibuffer_auto_raise = p->auto_raise;
auto_saving = 0;
if (stream != NULL)
{
@ -5510,15 +5510,6 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
fclose (stream);
unblock_input ();
}
return Qnil;
}
static Lisp_Object
do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */
{
minibuffer_auto_raise = XINT (value);
return Qnil;
}
static Lisp_Object
@ -5561,6 +5552,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
ptrdiff_t count = SPECPDL_INDEX ();
bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
bool old_message_p = 0;
struct auto_save_unwind auto_save_unwind;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
@ -5572,7 +5564,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
if (NILP (no_message))
{
old_message_p = push_message ();
record_unwind_protect (pop_message_unwind, Qnil);
record_unwind_protect_void (pop_message_unwind);
}
/* Ordinarily don't quit within this function,
@ -5611,10 +5603,9 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
stream = emacs_fopen (SSDATA (listfile), "w");
}
record_unwind_protect (do_auto_save_unwind,
make_save_pointer (stream));
record_unwind_protect (do_auto_save_unwind_1,
make_number (minibuffer_auto_raise));
auto_save_unwind.stream = stream;
auto_save_unwind.auto_raise = minibuffer_auto_raise;
record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
minibuffer_auto_raise = 0;
auto_saving = 1;
auto_save_error_occurred = 0;

24
src/filelock.c
View file

@ -257,18 +257,14 @@ void
get_boot_time_1 (const char *filename, bool newest)
{
struct utmp ut, *utp;
int desc;
if (filename)
{
/* On some versions of IRIX, opening a nonexistent file name
is likely to crash in the utmp routines. */
desc = emacs_open (filename, O_RDONLY, 0);
if (desc < 0)
if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0)
return;
emacs_close (desc);
utmpname (filename);
}
@ -412,8 +408,6 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
USE_SAFE_ALLOCA;
char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base);
int fd;
bool need_fchmod;
mode_t world_readable = S_IRUSR | S_IRGRP | S_IROTH;
memcpy (nonce, lfname, lfdirlen);
strcpy (nonce + lfdirlen, nonce_base);
@ -421,17 +415,14 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
/* Prefer mkostemp to mkstemp, as it avoids a window where FD is
temporarily open without close-on-exec. */
fd = mkostemp (nonce, O_BINARY | O_CLOEXEC);
need_fchmod = 1;
#elif HAVE_MKSTEMP
/* Prefer mkstemp to mktemp, as it avoids a race between
mktemp and emacs_open. */
fd = mkstemp (nonce);
need_fchmod = 1;
#else
mktemp (nonce);
fd = emacs_open (nonce, O_WRONLY | O_CREAT | O_EXCL | O_BINARY,
world_readable);
need_fchmod = 0;
S_IRUSR | S_IWUSR);
#endif
if (fd < 0)
@ -439,13 +430,15 @@ 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
|| (need_fchmod && fchmod (fd, world_readable) != 0))
/* 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
the lock file need not survive system crashes. */
@ -517,7 +510,8 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0);
if (0 <= fd)
{
ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
/* Use read, not emacs_read, since FD isn't unwind-protected. */
ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
int read_errno = errno;
if (emacs_close (fd) != 0)
return -1;

13
src/fns.c
View file

@ -1962,7 +1962,7 @@ The PLIST is modified by side effects. */)
prev = tail;
QUIT;
}
newcell = Fcons (prop, Fcons (val, Qnil));
newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
else
@ -2455,9 +2455,8 @@ is nil, and `use-dialog-box' is non-nil. */)
{
Lisp_Object pane, menu, obj;
redisplay_preserve_echo_area (4);
pane = Fcons (Fcons (build_string ("Yes"), Qt),
Fcons (Fcons (build_string ("No"), Qnil),
Qnil));
pane = list2 (Fcons (build_string ("Yes"), Qt),
Fcons (build_string ("No"), Qnil));
GCPRO1 (pane);
menu = Fcons (prompt, pane);
obj = Fx_popup_dialog (Qt, menu, Qnil);
@ -2586,10 +2585,10 @@ particular subfeatures supported in this version of FEATURE. */)
static Lisp_Object require_nesting_list;
static Lisp_Object
static void
require_unwind (Lisp_Object old_value)
{
return require_nesting_list = old_value;
require_nesting_list = old_value;
}
DEFUN ("require", Frequire, Srequire, 1, 3, 0,
@ -4915,7 +4914,7 @@ syms_of_fns (void)
DEFVAR_LISP ("features", Vfeatures,
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
Vfeatures = Fcons (intern_c_string ("emacs"), Qnil);
Vfeatures = list1 (intern_c_string ("emacs"));
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");

15
src/font.c
View file

@ -472,7 +472,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct
goto invalid_entry;
val = Fcons (make_number (encoding_id), make_number (repertory_id));
font_charset_alist
= nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil));
= nconc2 (font_charset_alist, list1 (Fcons (registry, val)));
}
if (encoding)
@ -483,7 +483,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct
invalid_entry:
font_charset_alist
= nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
= nconc2 (font_charset_alist, list1 (Fcons (registry, Qnil)));
return -1;
}
@ -1453,7 +1453,7 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
else
{
extra_props = nconc2 (extra_props,
Fcons (Fcons (key, val), Qnil));
list1 (Fcons (key, val)));
}
}
p = q;
@ -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;
@ -2519,7 +2519,7 @@ font_prepare_cache (FRAME_PTR f, struct font_driver *driver)
val = XCDR (val);
if (NILP (val))
{
val = Fcons (driver->type, Fcons (make_number (1), Qnil));
val = list2 (driver->type, make_number (1));
XSETCDR (cache, Fcons (val, XCDR (cache)));
}
else
@ -3517,8 +3517,7 @@ font_update_drivers (FRAME_PTR f, Lisp_Object new_drivers)
for (list = f->font_driver_list; list; list = list->next)
if (list->on)
active_drivers = nconc2 (active_drivers,
Fcons (list->driver->type, Qnil));
active_drivers = nconc2 (active_drivers, list1 (list->driver->type));
return active_drivers;
}
@ -4133,7 +4132,7 @@ how close they are to PREFER. */)
return Qnil;
if (NILP (XCDR (list))
&& ASIZE (XCAR (list)) == 1)
return Fcons (AREF (XCAR (list), 0), Qnil);
return list1 (AREF (XCAR (list), 0));
if (! NILP (prefer))
vec = font_sort_entities (list, prefer, frame, 0);

18
src/fontset.c
View file

@ -1523,7 +1523,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
{
if (XFASTINT (target) < 0x80)
error ("Can't set a font for partial ASCII range");
range_list = Fcons (Fcons (target, target), Qnil);
range_list = list1 (Fcons (target, target));
}
else if (CONSP (target))
{
@ -1539,7 +1539,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
error ("Can't set a font for partial ASCII range");
ascii_changed = 1;
}
range_list = Fcons (target, Qnil);
range_list = list1 (target);
}
else if (SYMBOLP (target) && !NILP (target))
{
@ -1552,7 +1552,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
{
if (EQ (target, Qlatin))
ascii_changed = 1;
val = Fcons (target, Qnil);
val = list1 (target);
map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
val);
range_list = Fnreverse (XCDR (val));
@ -1568,7 +1568,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
SDATA (SYMBOL_NAME (target)));
}
else if (NILP (target))
range_list = Fcons (Qnil, Qnil);
range_list = list1 (Qnil);
else
error ("Invalid target for setting a font");
@ -1628,7 +1628,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (! NILP (font_object))
{
update_auto_fontset_alist (font_object, fontset);
alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil);
alist = list1 (Fcons (Qfont, Fcons (name, font_object)));
Fmodify_frame_parameters (fr, alist);
}
}
@ -1999,7 +1999,7 @@ format is the same as above. */)
slot = Fassq (RFONT_DEF_SPEC (elt), alist);
name = AREF (font_object, FONT_NAME_INDEX);
if (NILP (Fmember (name, XCDR (slot))))
nconc2 (slot, Fcons (name, Qnil));
nconc2 (slot, list1 (name));
}
}
}
@ -2238,9 +2238,9 @@ alternate fontnames (if any) are tried instead. */);
DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
doc: /* Alist of fontset names vs the aliases. */);
Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
build_pure_c_string ("fontset-default")),
Qnil);
Vfontset_alias_alist
= list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
build_pure_c_string ("fontset-default")));
DEFVAR_LISP ("vertical-centering-font-regexp",
Vvertical_centering_font_regexp,

57
src/frame.c
View file

@ -389,7 +389,7 @@ make_frame (int mini_p)
etc. Running Lisp functions at this point surely ends in a
SEGV. */
set_window_buffer (root_window, buf, 0, 0);
fset_buffer_list (f, Fcons (buf, Qnil));
fset_buffer_list (f, list1 (buf));
}
if (mini_p)
@ -726,15 +726,15 @@ affects all frames on the same terminal device. */)
calculate_costs (f);
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame, parms);
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type,
build_string (t->display_info.tty->type)),
Qnil));
Fmodify_frame_parameters
(frame, list1 (Fcons (Qtty_type,
build_string (t->display_info.tty->type))));
if (t->display_info.tty->name != NULL)
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty,
build_string (t->display_info.tty->name)),
Qnil));
Fmodify_frame_parameters
(frame, list1 (Fcons (Qtty,
build_string (t->display_info.tty->name))));
else
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil));
Fmodify_frame_parameters (frame, list1 (Fcons (Qtty, Qnil)));
/* Make the frame face alist be frame-specific, so that each
frame could change its face definitions independently. */
@ -887,6 +887,26 @@ This function returns FRAME, or nil if FRAME has been deleted. */)
return do_switch_frame (frame, 1, 0, norecord);
}
DEFUN ("handle-focus-in", Fhandle_focus_in, Shandle_focus_in, 1, 1, "e",
doc: /* Handle a focus-in event.
Focus in events are usually bound to this function.
Focus in events occur when a frame has focus, but a switch-frame event
is not generated.
This function checks if blink-cursor timers should be turned on again. */)
(Lisp_Object event)
{
return call0 (intern ("blink-cursor-check"));
}
DEFUN ("handle-focus-out", Fhandle_focus_out, Shandle_focus_out, 1, 1, "e",
doc: /* Handle a focus-out event.
Focus out events are usually bound to this function.
Focus out events occur when no frame has focus.
This function checks if blink-cursor timers should be turned off. */)
(Lisp_Object event)
{
return call0 (intern ("blink-cursor-suspend"));
}
DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e",
doc: /* Handle a switch-frame event EVENT.
@ -902,6 +922,7 @@ to that frame. */)
/* Preserve prefix arg that the command loop just cleared. */
kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
Frun_hooks (1, &Qmouse_leave_buffer_hook);
Fhandle_focus_in (event); // switch-frame implies a focus in.
return do_switch_frame (event, 0, 0, Qnil);
}
@ -2731,7 +2752,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
{
left_no_change = 1;
if (f->left_pos < 0)
left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil));
left = list2 (Qplus, make_number (f->left_pos));
else
XSETINT (left, f->left_pos);
}
@ -2739,7 +2760,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist)
{
top_no_change = 1;
if (f->top_pos < 0)
top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil));
top = list2 (Qplus, make_number (f->top_pos));
else
XSETINT (top, f->top_pos);
}
@ -2874,13 +2895,13 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
if (f->left_pos >= 0)
store_in_alist (alistptr, Qleft, tem);
else
store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
store_in_alist (alistptr, Qleft, list2 (Qplus, tem));
XSETINT (tem, f->top_pos);
if (f->top_pos >= 0)
store_in_alist (alistptr, Qtop, tem);
else
store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
store_in_alist (alistptr, Qborder_width,
make_number (f->border_width));
@ -3739,7 +3760,7 @@ x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop,
tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type);
if (EQ (tem, Qunbound))
tem = deflt;
x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
return tem;
}
@ -3871,9 +3892,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
Lisp_Object element;
if (x >= 0 && (geometry & XNegative))
element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
element = list3 (Qleft, Qminus, make_number (-x));
else if (x < 0 && ! (geometry & XNegative))
element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
element = list3 (Qleft, Qplus, make_number (x));
else
element = Fcons (Qleft, make_number (x));
result = Fcons (element, result);
@ -3884,9 +3905,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
Lisp_Object element;
if (y >= 0 && (geometry & YNegative))
element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
element = list3 (Qtop, Qminus, make_number (-y));
else if (y < 0 && ! (geometry & YNegative))
element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
element = list3 (Qtop, Qplus, make_number (y));
else
element = Fcons (Qtop, make_number (y));
result = Fcons (element, result);
@ -4449,6 +4470,8 @@ automatically. See also `mouse-autoselect-window'. */);
defsubr (&Swindow_system);
defsubr (&Smake_terminal_frame);
defsubr (&Shandle_switch_frame);
defsubr (&Shandle_focus_in);
defsubr (&Shandle_focus_out);
defsubr (&Sselect_frame);
defsubr (&Sselected_frame);
defsubr (&Sframe_list);

11
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);
}
@ -2703,13 +2703,12 @@ syms_of_ftfont (void)
DEFSYM (Qsans__serif, "sans serif");
staticpro (&freetype_font_cache);
freetype_font_cache = Fcons (Qt, Qnil);
freetype_font_cache = list1 (Qt);
staticpro (&ftfont_generic_family_list);
ftfont_generic_family_list
= Fcons (Fcons (Qmonospace, Qt),
Fcons (Fcons (Qsans_serif, Qt),
Fcons (Fcons (Qsans, Qt), Qnil)));
ftfont_generic_family_list = list3 (Fcons (Qmonospace, Qt),
Fcons (Qsans_serif, Qt),
Fcons (Qsans, Qt));
staticpro (&ft_face_cache);
ft_face_cache = Qnil;

2
src/gfilenotify.c
View file

@ -173,7 +173,7 @@ will be reported only in case of the 'moved' event. */)
CHECK_STRING (file);
file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
if (NILP (Ffile_exists_p (file)))
report_file_error ("File does not exists", Fcons (file, Qnil));
report_file_error ("File does not exist", file);
CHECK_LIST (flags);

10
src/gtkutil.c
View file

@ -1650,10 +1650,10 @@ xg_dialog_response_cb (GtkDialog *w,
/* Destroy the dialog. This makes it pop down. */
static Lisp_Object
pop_down_dialog (Lisp_Object arg)
static void
pop_down_dialog (void *arg)
{
struct xg_dialog_data *dd = XSAVE_POINTER (arg, 0);
struct xg_dialog_data *dd = arg;
block_input ();
if (dd->w) gtk_widget_destroy (dd->w);
@ -1663,8 +1663,6 @@ pop_down_dialog (Lisp_Object arg)
g_main_loop_unref (dd->loop);
unblock_input ();
return Qnil;
}
/* If there are any emacs timers pending, add a timeout to main loop in DATA.
@ -1719,7 +1717,7 @@ xg_dialog_run (FRAME_PTR f, GtkWidget *w)
g_signal_connect (G_OBJECT (w), "delete-event", G_CALLBACK (gtk_true), NULL);
gtk_widget_show (w);
record_unwind_protect (pop_down_dialog, make_save_pointer (&dd));
record_unwind_protect_ptr (pop_down_dialog, &dd);
(void) xg_maybe_add_timer (&dd);
g_main_loop_run (dd.loop);

38
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;
}
}
@ -7581,8 +7586,7 @@ gif_load (struct frame *f, struct image *img)
delay |= ext->Bytes[1];
}
}
img->lisp_data = Fcons (Qextension_data,
Fcons (img->lisp_data, Qnil));
img->lisp_data = list2 (Qextension_data, img->lisp_data);
if (delay)
img->lisp_data
= Fcons (Qdelay,

36
src/insdel.c
View file

@ -1913,12 +1913,18 @@ prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end,
VARIABLE is the variable to maybe set to nil.
NO-ERROR-FLAG is nil if there was an error,
anything else meaning no error (so this function does nothing). */
static Lisp_Object
reset_var_on_error (Lisp_Object val)
struct rvoe_arg
{
if (NILP (XCDR (val)))
Fset (XCAR (val), Qnil);
return Qnil;
Lisp_Object *location;
bool errorp;
};
static void
reset_var_on_error (void *ptr)
{
struct rvoe_arg *p = ptr;
if (p->errorp)
*p->location = Qnil;
}
/* Signal a change to the buffer immediately before it happens.
@ -1936,6 +1942,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
Lisp_Object preserve_marker;
struct gcpro gcpro1, gcpro2, gcpro3;
ptrdiff_t count = SPECPDL_INDEX ();
struct rvoe_arg rvoe_arg;
if (inhibit_modification_hooks)
return;
@ -1963,13 +1970,14 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
if (!NILP (Vbefore_change_functions))
{
Lisp_Object args[3];
Lisp_Object rvoe_arg = Fcons (Qbefore_change_functions, Qnil);
rvoe_arg.location = &Vbefore_change_functions;
rvoe_arg.errorp = 1;
PRESERVE_VALUE;
PRESERVE_START_END;
/* Mark before-change-functions to be reset to nil in case of error. */
record_unwind_protect (reset_var_on_error, rvoe_arg);
record_unwind_protect_ptr (reset_var_on_error, &rvoe_arg);
/* Actually run the hook functions. */
args[0] = Qbefore_change_functions;
@ -1978,7 +1986,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
Frun_hook_with_args (3, args);
/* There was no error: unarm the reset_on_error. */
XSETCDR (rvoe_arg, Qt);
rvoe_arg.errorp = 0;
}
if (buffer_has_overlays ())
@ -2009,6 +2017,8 @@ void
signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
{
ptrdiff_t count = SPECPDL_INDEX ();
struct rvoe_arg rvoe_arg;
if (inhibit_modification_hooks)
return;
@ -2042,10 +2052,11 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
if (!NILP (Vafter_change_functions))
{
Lisp_Object args[4];
Lisp_Object rvoe_arg = Fcons (Qafter_change_functions, Qnil);
rvoe_arg.location = &Vafter_change_functions;
rvoe_arg.errorp = 1;
/* Mark after-change-functions to be reset to nil in case of error. */
record_unwind_protect (reset_var_on_error, rvoe_arg);
record_unwind_protect_ptr (reset_var_on_error, &rvoe_arg);
/* Actually run the hook functions. */
args[0] = Qafter_change_functions;
@ -2055,7 +2066,7 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
Frun_hook_with_args (4, args);
/* There was no error: unarm the reset_on_error. */
XSETCDR (rvoe_arg, Qt);
rvoe_arg.errorp = 0;
}
if (buffer_has_overlays ())
@ -2075,11 +2086,10 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
unbind_to (count, Qnil);
}
static Lisp_Object
static void
Fcombine_after_change_execute_1 (Lisp_Object val)
{
Vcombine_after_change_calls = val;
return val;
}
DEFUN ("combine-after-change-execute", Fcombine_after_change_execute,

295
src/keyboard.c
View file

@ -295,6 +295,7 @@ static struct input_event * volatile kbd_store_ptr;
static Lisp_Object Qmouse_movement;
static Lisp_Object Qscroll_bar_movement;
Lisp_Object Qswitch_frame;
static Lisp_Object Qfocus_in, Qfocus_out;
static Lisp_Object Qdelete_frame;
static Lisp_Object Qiconify_frame;
static Lisp_Object Qmake_frame_visible;
@ -359,7 +360,7 @@ Lisp_Object Qvertical_line;
static Lisp_Object Qvertical_scroll_bar;
Lisp_Object Qmenu_bar;
static Lisp_Object recursive_edit_unwind (Lisp_Object buffer);
static void recursive_edit_unwind (Lisp_Object buffer);
static Lisp_Object command_loop (void);
static Lisp_Object Qcommand_execute;
EMACS_TIME timer_check (void);
@ -423,12 +424,14 @@ static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
Lisp_Object, const char *const *,
Lisp_Object *, ptrdiff_t);
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
static Lisp_Object make_lispy_focus_in (Lisp_Object);
static Lisp_Object make_lispy_focus_out (Lisp_Object);
static bool help_char_p (Lisp_Object);
static void save_getcjmp (sys_jmp_buf);
static void restore_getcjmp (sys_jmp_buf);
static Lisp_Object apply_modifiers (int, Lisp_Object);
static void clear_event (struct input_event *);
static Lisp_Object restore_kboard_configuration (Lisp_Object);
static void restore_kboard_configuration (int);
#ifdef USABLE_SIGIO
static void deliver_input_available_signal (int signo);
#endif
@ -844,7 +847,7 @@ This function is called by the editor initialization to begin editing. */)
return unbind_to (count, Qnil);
}
Lisp_Object
void
recursive_edit_unwind (Lisp_Object buffer)
{
if (BUFFERP (buffer))
@ -852,7 +855,6 @@ recursive_edit_unwind (Lisp_Object buffer)
command_loop_level--;
update_mode_lines = 1;
return Qnil;
}
@ -949,7 +951,7 @@ pop_kboard (void)
from which further input is accepted. If F is non-nil, set its
KBOARD as the current keyboard.
This function uses record_unwind_protect to return to the previous
This function uses record_unwind_protect_int to return to the previous
state later.
If Emacs is already in single_kboard mode, and F's keyboard is
@ -980,8 +982,7 @@ temporarily_switch_to_single_kboard (struct frame *f)
else if (f != NULL)
current_kboard = FRAME_KBOARD (f);
single_kboard = 1;
record_unwind_protect (restore_kboard_configuration,
(was_locked ? Qt : Qnil));
record_unwind_protect_int (restore_kboard_configuration, was_locked);
}
#if 0 /* This function is not needed anymore. */
@ -990,26 +991,22 @@ record_single_kboard_state ()
{
if (single_kboard)
push_kboard (current_kboard);
record_unwind_protect (restore_kboard_configuration,
(single_kboard ? Qt : Qnil));
record_unwind_protect_int (restore_kboard_configuration, single_kboard);
}
#endif
static Lisp_Object
restore_kboard_configuration (Lisp_Object was_locked)
static void
restore_kboard_configuration (int was_locked)
{
if (NILP (was_locked))
single_kboard = 0;
else
single_kboard = was_locked;
if (was_locked)
{
struct kboard *prev = current_kboard;
single_kboard = 1;
pop_kboard ();
/* The pop should not change the kboard. */
if (single_kboard && current_kboard != prev)
emacs_abort ();
}
return Qnil;
}
@ -1237,7 +1234,7 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0,
/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
of this function. */
static Lisp_Object
static void
tracking_off (Lisp_Object old_value)
{
do_mouse_tracking = old_value;
@ -1254,7 +1251,6 @@ tracking_off (Lisp_Object old_value)
get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
}
}
return Qnil;
}
DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
@ -1317,17 +1313,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
void safe_run_hooks (Lisp_Object);
static void adjust_point_for_property (ptrdiff_t, bool);
/* Cancel hourglass from protect_unwind.
ARG is not used. */
#ifdef HAVE_WINDOW_SYSTEM
static Lisp_Object
cancel_hourglass_unwind (Lisp_Object arg)
{
cancel_hourglass ();
return Qnil;
}
#endif
/* The last boundary auto-added to buffer-undo-list. */
Lisp_Object last_undo_boundary;
@ -1430,7 +1415,7 @@ command_loop_1 (void)
if (!NILP (Vquit_flag))
{
Vquit_flag = Qnil;
Vunread_command_events = Fcons (make_number (quit_char), Qnil);
Vunread_command_events = list1 (make_number (quit_char));
}
}
@ -1562,7 +1547,7 @@ command_loop_1 (void)
if (display_hourglass_p
&& NILP (Vexecuting_kbd_macro))
{
record_unwind_protect (cancel_hourglass_unwind, Qnil);
record_unwind_protect_void (cancel_hourglass);
start_hourglass ();
}
#endif
@ -2204,14 +2189,13 @@ static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
static void record_char (Lisp_Object c);
static Lisp_Object help_form_saved_window_configs;
static Lisp_Object
read_char_help_form_unwind (Lisp_Object arg)
static void
read_char_help_form_unwind (void)
{
Lisp_Object window_config = XCAR (help_form_saved_window_configs);
help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
if (!NILP (window_config))
Fset_window_configuration (window_config);
return Qnil;
}
#define STOP_POLLING \
@ -2258,9 +2242,9 @@ read_event_from_main_queue (EMACS_TIME *end_time,
emacs_abort ();
}
if (!CONSP (last))
kset_kbd_queue (kb, Fcons (c, Qnil));
kset_kbd_queue (kb, list1 (c));
else
XSETCDR (last, Fcons (c, Qnil));
XSETCDR (last, list1 (c));
kb->kbd_queue_has_data = 1;
c = Qnil;
if (single_kboard)
@ -2682,9 +2666,9 @@ read_char (int commandflag, Lisp_Object map,
emacs_abort ();
}
if (!CONSP (last))
kset_kbd_queue (kb, Fcons (c, Qnil));
kset_kbd_queue (kb, list1 (c));
else
XSETCDR (last, Fcons (c, Qnil));
XSETCDR (last, list1 (c));
kb->kbd_queue_has_data = 1;
current_kboard = kb;
/* This is going to exit from read_char
@ -3002,7 +2986,7 @@ read_char (int commandflag, Lisp_Object map,
if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
{
/* Change menu-bar to (menu-bar) as the event "position". */
POSN_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
POSN_SET_POSN (EVENT_START (c), list1 (posn));
also_record = c;
Vunread_command_events = Fcons (c, Vunread_command_events);
@ -3199,7 +3183,7 @@ read_char (int commandflag, Lisp_Object map,
help_form_saved_window_configs
= Fcons (Fcurrent_window_configuration (Qnil),
help_form_saved_window_configs);
record_unwind_protect (read_char_help_form_unwind, Qnil);
record_unwind_protect_void (read_char_help_form_unwind);
call0 (Qhelp_form_show);
cancel_echoing ();
@ -3585,8 +3569,8 @@ kbd_buffer_store_event_hold (register struct input_event *event,
if (single_kboard && kb != current_kboard)
{
kset_kbd_queue
(kb, Fcons (make_lispy_switch_frame (event->frame_or_window),
Fcons (make_number (c), Qnil)));
(kb, list2 (make_lispy_switch_frame (event->frame_or_window),
make_number (c)));
kb->kbd_queue_has_data = 1;
for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
{
@ -3949,9 +3933,9 @@ kbd_buffer_get_event (KBOARD **kbp,
else if (event->kind == NS_TEXT_EVENT)
{
if (event->code == KEY_NS_PUT_WORKING_TEXT)
obj = Fcons (intern ("ns-put-working-text"), Qnil);
obj = list1 (intern ("ns-put-working-text"));
else
obj = Fcons (intern ("ns-unput-working-text"), Qnil);
obj = list1 (intern ("ns-unput-working-text"));
kbd_fetch_ptr = event + 1;
if (used_mouse_menu)
*used_mouse_menu = 1;
@ -3963,8 +3947,7 @@ kbd_buffer_get_event (KBOARD **kbp,
else if (event->kind == DELETE_WINDOW_EVENT)
{
/* Make an event (delete-frame (FRAME)). */
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
obj = list2 (Qdelete_frame, list1 (event->frame_or_window));
kbd_fetch_ptr = event + 1;
}
#endif
@ -3973,15 +3956,13 @@ kbd_buffer_get_event (KBOARD **kbp,
else if (event->kind == ICONIFY_EVENT)
{
/* Make an event (iconify-frame (FRAME)). */
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
obj = list2 (Qiconify_frame, list1 (event->frame_or_window));
kbd_fetch_ptr = event + 1;
}
else if (event->kind == DEICONIFY_EVENT)
{
/* Make an event (make-frame-visible (FRAME)). */
obj = Fcons (event->frame_or_window, Qnil);
obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
obj = list2 (Qmake_frame_visible, list1 (event->frame_or_window));
kbd_fetch_ptr = event + 1;
}
#endif
@ -4004,11 +3985,11 @@ kbd_buffer_get_event (KBOARD **kbp,
#ifdef HAVE_NTGUI
else if (event->kind == LANGUAGE_CHANGE_EVENT)
{
/* Make an event (language-change (FRAME CODEPAGE LANGUAGE-ID)). */
obj = Fcons (Qlanguage_change,
list3 (event->frame_or_window,
make_number (event->code),
make_number (event->modifiers)));
/* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */
obj = list4 (Qlanguage_change,
event->frame_or_window,
make_number (event->code),
make_number (event->modifiers));
kbd_fetch_ptr = event + 1;
}
#endif
@ -4017,11 +3998,11 @@ kbd_buffer_get_event (KBOARD **kbp,
{
#ifdef HAVE_W32NOTIFY
/* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */
obj = Fcons (Qfile_notify,
list2 (list3 (make_number (event->code),
XCAR (event->arg),
XCDR (event->arg)),
event->frame_or_window));
obj = list3 (Qfile_notify,
list3 (make_number (event->code),
XCAR (event->arg),
XCDR (event->arg)),
event->frame_or_window);
#else
obj = make_lispy_event (event);
#endif
@ -4030,7 +4011,7 @@ kbd_buffer_get_event (KBOARD **kbp,
#endif /* USE_FILE_NOTIFY */
else if (event->kind == SAVE_SESSION_EVENT)
{
obj = Fcons (Qsave_session, Fcons (event->arg, Qnil));
obj = list2 (Qsave_session, event->arg);
kbd_fetch_ptr = event + 1;
}
/* Just discard these, by returning nil.
@ -4067,17 +4048,43 @@ kbd_buffer_get_event (KBOARD **kbp,
switch-frame event if necessary. */
Lisp_Object frame, focus;
frame = event->frame_or_window;
focus = FRAME_FOCUS_FRAME (XFRAME (frame));
if (FRAMEP (focus))
frame = focus;
frame = event->frame_or_window;
focus = FRAME_FOCUS_FRAME (XFRAME (frame));
if (FRAMEP (focus))
frame = focus;
if (!EQ (frame, internal_last_event_frame)
&& !EQ (frame, selected_frame))
obj = make_lispy_switch_frame (frame);
internal_last_event_frame = frame;
kbd_fetch_ptr = event + 1;
}
if (
#ifdef HAVE_X11
! NILP (event->arg)
&&
#endif
!EQ (frame, internal_last_event_frame)
&& !EQ (frame, selected_frame))
obj = make_lispy_switch_frame (frame);
else
obj = make_lispy_focus_in (frame);
internal_last_event_frame = frame;
kbd_fetch_ptr = event + 1;
}
else if (event->kind == FOCUS_OUT_EVENT)
{
#ifdef HAVE_WINDOW_SYSTEM
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_WINDOW_SYSTEM */
kbd_fetch_ptr = event + 1;
}
#ifdef HAVE_DBUS
else if (event->kind == DBUS_EVENT)
{
@ -5572,14 +5579,12 @@ make_lispy_event (struct input_event *event)
/* ELisp manual 2.4b says (x y) are window relative but
code says they are frame-relative. */
position
= Fcons (event->frame_or_window,
Fcons (Qmenu_bar,
Fcons (Fcons (event->x, event->y),
Fcons (make_number (event->timestamp),
Qnil))));
position = list4 (event->frame_or_window,
Qmenu_bar,
Fcons (event->x, event->y),
make_number (event->timestamp));
return Fcons (item, Fcons (position, Qnil));
return list2 (item, position);
}
#endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */
@ -5598,12 +5603,9 @@ make_lispy_event (struct input_event *event)
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
position
= Fcons (window,
Fcons (Qvertical_scroll_bar,
Fcons (portion_whole,
Fcons (make_number (event->timestamp),
Fcons (part, Qnil)))));
position = list5 (window, Qvertical_scroll_bar,
portion_whole, make_number (event->timestamp),
part);
}
#endif /* not USE_TOOLKIT_SCROLL_BARS */
@ -5751,19 +5753,11 @@ make_lispy_event (struct input_event *event)
&mouse_syms,
ASIZE (mouse_syms));
if (event->modifiers & drag_modifier)
return Fcons (head,
Fcons (start_pos,
Fcons (position,
Qnil)));
return list3 (head, start_pos, position);
else if (event->modifiers & (double_modifier | triple_modifier))
return Fcons (head,
Fcons (position,
Fcons (make_number (double_click_count),
Qnil)));
return list3 (head, position, make_number (double_click_count));
else
return Fcons (head,
Fcons (position,
Qnil));
return list2 (head, position);
}
}
@ -5862,14 +5856,9 @@ make_lispy_event (struct input_event *event)
}
if (event->modifiers & (double_modifier | triple_modifier))
return Fcons (head,
Fcons (position,
Fcons (make_number (double_click_count),
Qnil)));
return list3 (head, position, make_number (double_click_count));
else
return Fcons (head,
Fcons (position,
Qnil));
return list2 (head, position);
}
@ -5900,12 +5889,8 @@ make_lispy_event (struct input_event *event)
portion_whole = Fcons (event->x, event->y);
part = *scroll_bar_parts[(int) event->part];
position
= Fcons (window,
Fcons (Qvertical_scroll_bar,
Fcons (portion_whole,
Fcons (make_number (event->timestamp),
Fcons (part, Qnil)))));
position = list5 (window, Qvertical_scroll_bar, portion_whole,
make_number (event->timestamp), part);
/* Always treat scroll bar events as clicks. */
event->modifiers |= click_modifier;
@ -5923,7 +5908,7 @@ make_lispy_event (struct input_event *event)
Vlispy_mouse_stem,
NULL, &mouse_syms,
ASIZE (mouse_syms));
return Fcons (head, Fcons (position, Qnil));
return list2 (head, position);
}
#endif /* USE_TOOLKIT_SCROLL_BARS */
@ -5949,10 +5934,7 @@ make_lispy_event (struct input_event *event)
Qdrag_n_drop, Qnil,
lispy_drag_n_drop_names,
&drag_n_drop_syms, 1);
return Fcons (head,
Fcons (position,
Fcons (files,
Qnil)));
return list3 (head, position, files);
}
#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
@ -5962,22 +5944,20 @@ make_lispy_event (struct input_event *event)
/* This is the prefix key. We translate this to
`(menu_bar)' because the code in keyboard.c for menu
events, which we use, relies on this. */
return Fcons (Qmenu_bar, Qnil);
return list1 (Qmenu_bar);
return event->arg;
#endif
case SELECT_WINDOW_EVENT:
/* Make an event (select-window (WINDOW)). */
return Fcons (Qselect_window,
Fcons (Fcons (event->frame_or_window, Qnil),
Qnil));
return list2 (Qselect_window, list1 (event->frame_or_window));
case TOOL_BAR_EVENT:
if (EQ (event->arg, event->frame_or_window))
/* This is the prefix key. We translate this to
`(tool_bar)' because the code in keyboard.c for tool bar
events, which we use, relies on this. */
return Fcons (Qtool_bar, Qnil);
return list1 (Qtool_bar);
else if (SYMBOLP (event->arg))
return apply_modifiers (event->modifiers, event->arg);
return event->arg;
@ -6018,9 +5998,8 @@ make_lispy_event (struct input_event *event)
#endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */
case CONFIG_CHANGED_EVENT:
return Fcons (Qconfig_changed_event,
Fcons (event->arg,
Fcons (event->frame_or_window, Qnil)));
return list3 (Qconfig_changed_event,
event->arg, event->frame_or_window);
#ifdef HAVE_GPM
case GPM_CLICK_EVENT:
{
@ -6061,24 +6040,13 @@ make_lispy_event (struct input_event *event)
ASIZE (mouse_syms));
if (event->modifiers & drag_modifier)
return Fcons (head,
Fcons (start_pos,
Fcons (position,
Qnil)));
return list3 (head, start_pos, position);
else if (event->modifiers & double_modifier)
return Fcons (head,
Fcons (position,
Fcons (make_number (2),
Qnil)));
return list3 (head, position, make_number (2));
else if (event->modifiers & triple_modifier)
return Fcons (head,
Fcons (position,
Fcons (make_number (3),
Qnil)));
return list3 (head, position, make_number (3));
else
return Fcons (head,
Fcons (position,
Qnil));
return list2 (head, position);
}
#endif /* HAVE_GPM */
@ -6098,13 +6066,12 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa
Lisp_Object part_sym;
part_sym = *scroll_bar_parts[(int) part];
return Fcons (Qscroll_bar_movement,
Fcons (list5 (bar_window,
Qvertical_scroll_bar,
Fcons (x, y),
make_number (t),
part_sym),
Qnil));
return list2 (Qscroll_bar_movement,
list5 (bar_window,
Qvertical_scroll_bar,
Fcons (x, y),
make_number (t),
part_sym));
}
/* Or is it an ordinary mouse movement? */
else
@ -6119,7 +6086,18 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa
static Lisp_Object
make_lispy_switch_frame (Lisp_Object frame)
{
return Fcons (Qswitch_frame, Fcons (frame, Qnil));
return list2 (Qswitch_frame, frame);
}
static Lisp_Object
make_lispy_focus_in (Lisp_Object frame)
{
return list2 (Qfocus_in, frame);
}
static Lisp_Object
make_lispy_focus_out (Lisp_Object frame)
{
return list2 (Qfocus_out, frame);
}
/* Manipulating modifiers. */
@ -6352,7 +6330,7 @@ parse_modifiers (Lisp_Object symbol)
if (modifiers & ~INTMASK)
emacs_abort ();
XSETFASTINT (mask, modifiers);
elements = Fcons (unmodified, Fcons (mask, Qnil));
elements = list2 (unmodified, mask);
/* Cache the parsing results on SYMBOL. */
Fput (symbol, Qevent_symbol_element_mask,
@ -6425,7 +6403,7 @@ apply_modifiers (int modifiers, Lisp_Object base)
the caches:
XSETFASTINT (idx, modifiers);
Fput (new_symbol, Qevent_symbol_element_mask,
Fcons (base, Fcons (idx, Qnil)));
list2 (base, idx));
Fput (new_symbol, Qevent_symbol_elements,
Fcons (base, lispy_modifier_list (modifiers)));
Sadly, this is only correct if `base' is indeed a base event,
@ -7577,7 +7555,7 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm
ASET (menu_bar_items_vector, i, key); i++;
ASET (menu_bar_items_vector, i,
AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
ASET (menu_bar_items_vector, i, Fcons (item, Qnil)); i++;
ASET (menu_bar_items_vector, i, list1 (item)); i++;
ASET (menu_bar_items_vector, i, make_number (0)); i++;
menu_bar_items_index = i;
}
@ -8132,7 +8110,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
/* As an exception, allow old-style menu separators. */
if (STRINGP (XCAR (item)))
item = Fcons (XCAR (item), Qnil);
item = list1 (XCAR (item));
else if (!EQ (XCAR (item), Qmenu_item)
|| (item = XCDR (item), !CONSP (item)))
return 0;
@ -9364,8 +9342,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* Zap the position in key, so we know that we've
expanded it, and don't try to do so again. */
POSN_SET_POSN (EVENT_START (key),
Fcons (posn, Qnil));
POSN_SET_POSN (EVENT_START (key), list1 (posn));
mock_input = t + 2;
goto replay_sequence;
@ -9520,8 +9497,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
new_head
= apply_modifiers (modifiers, XCAR (breakdown));
new_click
= Fcons (new_head, Fcons (EVENT_START (key), Qnil));
new_click = list2 (new_head, EVENT_START (key));
/* Look for a binding for this new key. */
new_binding = follow_key (current_binding, new_click);
@ -10157,7 +10133,7 @@ The file will be closed when Emacs exits. */)
file = Fexpand_file_name (file, Qnil);
dribble = emacs_fopen (SSDATA (file), "w");
if (dribble == 0)
report_file_error ("Opening dribble", Fcons (file, Qnil));
report_file_error ("Opening dribble", file);
}
return Qnil;
}
@ -10222,8 +10198,7 @@ On such systems, Emacs starts a subshell instead of suspending. */)
reset_all_sys_modes ();
/* sys_suspend can get an error if it tries to fork a subshell
and the system resources aren't available for that. */
record_unwind_protect ((Lisp_Object (*) (Lisp_Object)) init_all_sys_modes,
Qnil);
record_unwind_protect_void (init_all_sys_modes);
stuff_buffered_input (stuffstring);
if (cannot_suspend)
sys_subshell ();
@ -10982,6 +10957,8 @@ static const struct event_head head_table[] = {
{&Qmouse_movement, "mouse-movement", &Qmouse_movement},
{&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
{&Qswitch_frame, "switch-frame", &Qswitch_frame},
{&Qfocus_in, "focus-in", &Qfocus_in},
{&Qfocus_out, "focus-out", &Qfocus_out},
{&Qdelete_frame, "delete-frame", &Qdelete_frame},
{&Qiconify_frame, "iconify-frame", &Qiconify_frame},
{&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
@ -11109,7 +11086,7 @@ syms_of_keyboard (void)
*p->var = intern_c_string (p->name);
staticpro (p->var);
Fput (*p->var, Qevent_kind, *p->kind);
Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
Fput (*p->var, Qevent_symbol_elements, list1 (*p->var));
}
}
@ -11504,7 +11481,7 @@ and the minor mode maps regardless of `overriding-local-map'. */);
DEFVAR_LISP ("special-event-map", Vspecial_event_map,
doc: /* Keymap defining bindings for special events to execute at low level. */);
Vspecial_event_map = Fcons (intern_c_string ("keymap"), Qnil);
Vspecial_event_map = list1 (intern_c_string ("keymap"));
DEFVAR_LISP ("track-mouse", do_mouse_tracking,
doc: /* Non-nil means generate motion events for mouse motion. */);
@ -11800,6 +11777,10 @@ keys_of_keyboard (void)
initial_define_lispy_key (Vspecial_event_map, "language-change",
"ignore");
#endif
initial_define_lispy_key (Vspecial_event_map, "focus-in",
"handle-focus-in");
initial_define_lispy_key (Vspecial_event_map, "focus-out",
"handle-focus-out");
}
/* Mark the pointers in the kboard objects.

2
src/keyboard.h
View file

@ -341,7 +341,7 @@ enum menu_item_idx
MENU_ITEMS_ITEM_LENGTH
};
extern Lisp_Object unuse_menu_items (Lisp_Object dummy);
extern void unuse_menu_items (void);
/* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU
isn't defined. The use of HAVE_MULTILINGUAL_MENU could probably be

35
src/keymap.c
View file

@ -129,7 +129,7 @@ in case you use it as a menu with `x-popup-menu'. */)
{
Lisp_Object tail;
if (!NILP (string))
tail = Fcons (string, Qnil);
tail = list1 (string);
else
tail = Qnil;
return Fcons (Qkeymap,
@ -151,9 +151,9 @@ in case you use it as a menu with `x-popup-menu'. */)
{
if (!NILP (Vpurify_flag))
string = Fpurecopy (string);
return Fcons (Qkeymap, Fcons (string, Qnil));
return list2 (Qkeymap, string);
}
return Fcons (Qkeymap, Qnil);
return list1 (Qkeymap);
}
/* This function is used for installing the standard key bindings
@ -534,12 +534,12 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
retval = val;
else if (CONSP (retval_tail))
{
XSETCDR (retval_tail, Fcons (val, Qnil));
XSETCDR (retval_tail, list1 (val));
retval_tail = XCDR (retval_tail);
}
else
{
retval_tail = Fcons (val, Qnil);
retval_tail = list1 (val);
retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
}
}
@ -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;
@ -1045,9 +1045,9 @@ However, a key definition which is a symbol whose definition is a keymap
is not copied. */)
(Lisp_Object keymap)
{
register Lisp_Object copy, tail;
Lisp_Object copy, tail;
keymap = get_keymap (keymap, 1, 0);
copy = tail = Fcons (Qkeymap, Qnil);
copy = tail = list1 (Qkeymap);
keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
@ -1073,7 +1073,7 @@ is not copied. */)
else
elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
}
XSETCDR (tail, Fcons (elt, Qnil));
XSETCDR (tail, list1 (elt));
tail = XCDR (tail);
keymap = XCDR (keymap);
}
@ -1341,8 +1341,7 @@ append_key (Lisp_Object key_sequence, Lisp_Object key)
Lisp_Object args[2];
args[0] = key_sequence;
args[1] = Fcons (key, Qnil);
args[1] = list1 (key);
return Fvconcat (2, args);
}
@ -1549,7 +1548,7 @@ like in the respective argument of `key-binding'. */)
{
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object keymaps = Fcons (current_global_map, Qnil);
Lisp_Object keymaps = list1 (current_global_map);
/* If a mouse click position is given, our variables are based on
the buffer clicked on, not the current buffer. So we may have to
@ -1809,7 +1808,7 @@ bindings; see the description of `lookup-key' for more details about this. */)
if (KEYMAPP (binding))
maps[j++] = Fcons (modes[i], binding);
else if (j == 0)
RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
RETURN_UNGCPRO (list1 (Fcons (modes[i], binding)));
}
UNGCPRO;
@ -1951,7 +1950,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *
else
{
tem = append_key (thisseq, key);
nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
nconc2 (tail, list1 (Fcons (tem, cmd)));
}
}
@ -2005,13 +2004,13 @@ then the value includes only maps for prefixes that start with PREFIX. */)
}
prefix = copy;
}
maps = Fcons (Fcons (prefix, tem), Qnil);
maps = list1 (Fcons (prefix, tem));
}
else
return Qnil;
}
else
maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
maps = list1 (Fcons (zero_vector, get_keymap (keymap, 1, 0)));
/* For each map in the list maps,
look at any other maps it points to,
@ -2619,7 +2618,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled:
if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
keymaps = keymap;
else if (!NILP (keymap))
keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
keymaps = list2 (keymap, current_global_map);
else
keymaps = Fcurrent_active_maps (Qnil, Qnil);

114
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).
@ -1819,46 +1818,27 @@ enum Lisp_Save_Type
/* Special object used to hold a different values for later use.
This is mostly used to package C integers and pointers to call
record_unwind_protect. A typical task is to pass just one C object
pointer to the unwind function. You should pack an object pointer with
make_save_pointer and then get it back with XSAVE_POINTER, e.g.:
record_unwind_protect when two or more values need to be saved.
For example:
...
struct my_data *md = get_my_data ();
record_unwind_protect (my_unwind, make_save_pointer (md));
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);
...
}
If you need to pass something else you can use make_save_value,
which allows you to 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:
...
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));
...
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);
@ -1868,12 +1848,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;
@ -2706,10 +2687,11 @@ typedef jmp_buf sys_jmp_buf;
used all over the place, needs to be fast, and needs to know the size of
union specbinding. But only eval.c should access it. */
typedef Lisp_Object (*specbinding_func) (Lisp_Object);
enum specbind_tag {
SPECPDL_UNWIND, /* An unwind_protect function. */
SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */
SPECPDL_UNWIND_PTR, /* Likewise, on void *. */
SPECPDL_UNWIND_INT, /* Likewise, on int. */
SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */
SPECPDL_BACKTRACE, /* An element of the backtrace. */
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
/* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
@ -2722,9 +2704,23 @@ union specbinding
ENUM_BF (specbind_tag) kind : CHAR_BIT;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
void (*func) (Lisp_Object);
Lisp_Object arg;
specbinding_func func;
} unwind;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
void (*func) (void *);
void *arg;
} unwind_ptr;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
void (*func) (int);
int arg;
} unwind_int;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
void (*func) (void);
} unwind_void;
struct {
ENUM_BF (specbind_tag) kind : CHAR_BIT;
/* `where' is not used in the case of SPECPDL_LET. */
@ -3423,7 +3419,7 @@ extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
extern void check_message_stack (void);
extern void setup_echo_area_for_printing (int);
extern bool push_message (void);
extern Lisp_Object pop_message_unwind (Lisp_Object);
extern void pop_message_unwind (void);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void restore_message (void);
extern Lisp_Object current_message (void);
@ -3585,8 +3581,16 @@ 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);
extern void free_cons (struct Lisp_Cons *);
@ -3743,12 +3747,18 @@ extern Lisp_Object internal_condition_case_n
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
extern void specbind (Lisp_Object, Lisp_Object);
extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object);
extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
extern void record_unwind_protect_int (void (*) (int), int);
extern void record_unwind_protect_ptr (void (*) (void *), void *);
extern void record_unwind_protect_void (void (*) (void));
extern void record_unwind_protect_nothing (void);
extern void clear_unwind_protect (ptrdiff_t);
extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern _Noreturn void verror (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern Lisp_Object un_autoload (Lisp_Object);
extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
extern void init_eval_once (void);
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
@ -3756,6 +3766,7 @@ extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
extern void syms_of_eval (void);
extern void unwind_body (Lisp_Object);
extern void record_in_backtrace (Lisp_Object function,
Lisp_Object *args, ptrdiff_t nargs);
extern void mark_specpdl (void);
@ -3771,8 +3782,8 @@ extern void insert1 (Lisp_Object);
extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
extern Lisp_Object save_excursion_save (void);
extern Lisp_Object save_restriction_save (void);
extern Lisp_Object save_excursion_restore (Lisp_Object);
extern Lisp_Object save_restriction_restore (Lisp_Object);
extern void save_excursion_restore (Lisp_Object);
extern void save_restriction_restore (Lisp_Object);
extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
@ -3791,7 +3802,6 @@ extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
Lisp_Object, Lisp_Object, Lisp_Object);
extern bool overlay_touches_p (ptrdiff_t);
extern Lisp_Object Vbuffer_alist;
extern Lisp_Object set_buffer_if_live (Lisp_Object);
extern Lisp_Object other_buffer_safely (Lisp_Object);
extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string;
extern Lisp_Object get_truename_buffer (Lisp_Object);
@ -3825,8 +3835,9 @@ extern Lisp_Object Qinsert_file_contents;
extern Lisp_Object Qfile_name_history;
extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */
extern Lisp_Object close_file_unwind (Lisp_Object);
extern Lisp_Object restore_point_unwind (Lisp_Object);
extern void close_file_unwind (int);
extern void fclose_unwind (void *);
extern void restore_point_unwind (Lisp_Object);
extern _Noreturn void report_file_errno (const char *, Lisp_Object, int);
extern _Noreturn void report_file_error (const char *, Lisp_Object);
extern bool internal_delete_file (Lisp_Object);
@ -4099,6 +4110,7 @@ extern void init_random (void);
extern void emacs_backtrace (int);
extern _Noreturn void emacs_abort (void) NO_INLINE;
extern int emacs_open (const char *, int, int);
extern int emacs_pipe (int[2]);
extern int emacs_close (int);
extern ptrdiff_t emacs_read (int, char *, ptrdiff_t);
extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t);
@ -4262,7 +4274,6 @@ extern void init_system_name (void);
enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
extern Lisp_Object safe_alloca_unwind (Lisp_Object);
extern void *record_xmalloc (size_t);
#define USE_SAFE_ALLOCA \
@ -4286,8 +4297,7 @@ extern void *record_xmalloc (size_t);
{ \
(buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
sa_must_free = 1; \
record_unwind_protect (safe_alloca_unwind, \
make_save_pointer (buf)); \
record_unwind_protect_ptr (xfree, buf); \
} \
} while (0)
@ -4312,9 +4322,9 @@ 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 (safe_alloca_unwind, arg_); \
record_unwind_protect (free_save_value, arg_); \
} \
else \
memory_full (SIZE_MAX); \

171
src/lread.c
View file

@ -145,7 +145,6 @@ static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
@ -562,7 +561,7 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
c = DECODE_CHAR (charset, code);
if (c < 0)
Fsignal (Qinvalid_read_syntax,
Fcons (build_string ("invalid multibyte form"), Qnil));
list1 (build_string ("invalid multibyte form")));
return c;
}
@ -672,7 +671,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required,
{
if (error_nonascii)
{
Vunread_command_events = Fcons (val, Qnil);
Vunread_command_events = list1 (val);
error ("Non-character input-event");
}
else
@ -952,10 +951,10 @@ safe_to_load_version (int fd)
/* Callback for record_unwind_protect. Restore the old load list OLD,
after loading a file successfully. */
static Lisp_Object
static void
record_load_unwind (Lisp_Object old)
{
return Vloads_in_progress = old;
Vloads_in_progress = old;
}
/* This handler function is used via internal_condition_case_1. */
@ -966,7 +965,7 @@ load_error_handler (Lisp_Object data)
return Qnil;
}
static Lisp_Object
static void
load_warn_old_style_backquotes (Lisp_Object file)
{
if (!NILP (Vold_style_backquotes))
@ -976,7 +975,6 @@ load_warn_old_style_backquotes (Lisp_Object file)
args[1] = file;
Fmessage (2, args);
}
return Qnil;
}
DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
@ -1041,10 +1039,12 @@ While the file is in the process of being loaded, the variable
is bound to the file's name.
Return t if the file exists and loads successfully. */)
(Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
(Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
Lisp_Object nosuffix, Lisp_Object must_suffix)
{
register FILE *stream;
register int fd = -1;
FILE *stream;
int fd;
int fd_index;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
@ -1055,7 +1055,6 @@ Return t if the file exists and loads successfully. */)
Lisp_Object handler;
bool safe_p = 1;
const char *fmode = "r";
Lisp_Object tmp[2];
int version;
#ifdef DOS_NT
@ -1088,19 +1087,23 @@ Return t if the file exists and loads successfully. */)
else
file = Fsubstitute_in_file_name (file);
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file. */
if (SBYTES (file) > 0)
if (SCHARS (file) == 0)
{
ptrdiff_t size = SBYTES (file);
fd = -1;
errno = ENOENT;
}
else
{
Lisp_Object suffixes;
found = Qnil;
GCPRO2 (file, found);
if (! NILP (must_suffix))
{
/* Don't insist on adding a suffix if FILE already ends with one. */
ptrdiff_t size = SBYTES (file);
if (size > 3
&& !strcmp (SSDATA (file) + size - 3, ".el"))
must_suffix = Qnil;
@ -1113,20 +1116,28 @@ Return t if the file exists and loads successfully. */)
must_suffix = Qnil;
}
fd = openp (Vload_path, file,
(!NILP (nosuffix) ? Qnil
: !NILP (must_suffix) ? Fget_load_suffixes ()
: Fappend (2, (tmp[0] = Fget_load_suffixes (),
tmp[1] = Vload_file_rep_suffixes,
tmp))),
&found, Qnil);
if (!NILP (nosuffix))
suffixes = Qnil;
else
{
suffixes = Fget_load_suffixes ();
if (NILP (must_suffix))
{
Lisp_Object arg[2];
arg[0] = suffixes;
arg[1] = Vload_file_rep_suffixes;
suffixes = Fappend (2, arg);
}
}
fd = openp (Vload_path, file, suffixes, &found, Qnil);
UNGCPRO;
}
if (fd == -1)
{
if (NILP (noerror))
xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
report_file_error ("Cannot open load file", file);
return Qnil;
}
@ -1164,6 +1175,12 @@ Return t if the file exists and loads successfully. */)
#endif
}
if (0 <= fd)
{
fd_index = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
}
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
@ -1179,11 +1196,7 @@ Return t if the file exists and loads successfully. */)
Lisp_Object tem;
for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
{
if (fd >= 0)
emacs_close (fd);
signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
}
signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
@ -1196,9 +1209,8 @@ Return t if the file exists and loads successfully. */)
/* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
tmp[1] = Ffile_name_nondirectory (found),
tmp))
? concat2 (Ffile_name_directory (file),
Ffile_name_nondirectory (found))
: found) ;
version = -1;
@ -1224,12 +1236,7 @@ Return t if the file exists and loads successfully. */)
{
safe_p = 0;
if (!load_dangerous_libraries)
{
if (fd >= 0)
emacs_close (fd);
error ("File `%s' was not compiled in Emacs",
SDATA (found));
}
error ("File `%s' was not compiled in Emacs", SDATA (found));
else if (!NILP (nomessage) && !force_load_messages)
message_with_string ("File `%s' not compiled in Emacs", found, 1);
}
@ -1275,7 +1282,10 @@ Return t if the file exists and loads successfully. */)
Lisp_Object val;
if (fd >= 0)
emacs_close (fd);
{
emacs_close (fd);
clear_unwind_protect (fd_index);
}
val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
(NILP (nomessage) || force_load_messages) ? Qnil : Qt);
@ -1285,26 +1295,28 @@ Return t if the file exists and loads successfully. */)
GCPRO3 (file, found, hist_file_name);
#ifdef WINDOWSNT
efound = ENCODE_FILE (found);
/* If we somehow got here with fd == -2, meaning the file is deemed
to be remote, don't even try to reopen the file locally; just
force a failure instead. */
if (fd >= 0)
if (fd < 0)
{
emacs_close (fd);
stream = emacs_fopen (SSDATA (efound), fmode);
/* We somehow got here with fd == -2, meaning the file is deemed
to be remote. Don't even try to reopen the file locally;
just force a failure. */
stream = NULL;
errno = EINVAL;
}
else
stream = NULL;
#else /* not WINDOWSNT */
stream = fdopen (fd, fmode);
#endif /* not WINDOWSNT */
if (stream == 0)
{
#ifdef WINDOWSNT
emacs_close (fd);
error ("Failure to create stdio stream for %s", SDATA (file));
clear_unwind_protect (fd_index);
efound = ENCODE_FILE (found);
stream = emacs_fopen (SSDATA (efound), fmode);
#else
stream = fdopen (fd, fmode);
#endif
}
if (! stream)
report_file_error ("Opening stdio stream", file);
set_unwind_protect_ptr (fd_index, fclose_unwind, stream);
if (! NILP (Vpurify_flag))
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
@ -1323,7 +1335,6 @@ Return t if the file exists and loads successfully. */)
message_with_string ("Loading %s...", file, 1);
}
record_unwind_protect (load_unwind, make_save_pointer (stream));
specbind (Qload_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
@ -1375,19 +1386,6 @@ Return t if the file exists and loads successfully. */)
return Qt;
}
static Lisp_Object
load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
{
FILE *stream = XSAVE_POINTER (arg, 0);
if (stream != NULL)
{
block_input ();
fclose (stream);
unblock_input ();
}
return Qnil;
}
static bool
complete_filename_p (Lisp_Object pathname)
@ -1494,7 +1492,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
@ -1523,7 +1521,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
bool exists;
last_errno = ENOENT;
if (NILP (predicate))
exists = !NILP (Ffile_readable_p (string));
else
@ -1578,7 +1575,10 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
{
fd = emacs_open (pfn, O_RDONLY, 0);
if (fd < 0)
last_errno = errno;
{
if (errno != ENOENT)
last_errno = errno;
}
else
{
struct stat st;
@ -1682,11 +1682,10 @@ build_load_history (Lisp_Object filename, bool entire)
Vload_history);
}
static Lisp_Object
readevalloop_1 (Lisp_Object old)
static void
readevalloop_1 (int old)
{
load_convert_to_unibyte = ! NILP (old);
return Qnil;
load_convert_to_unibyte = old;
}
/* Signal an `end-of-file' error, if possible with file name
@ -1756,7 +1755,7 @@ readevalloop (Lisp_Object readcharfun,
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
load_convert_to_unibyte = !NILP (unibyte);
/* If lexical binding is active (either because it was specified in
@ -1764,8 +1763,8 @@ readevalloop (Lisp_Object readcharfun,
lexical environment, otherwise, turn off lexical binding. */
lex_bound = find_symbol_value (Qlexical_binding);
specbind (Qinternal_interpreter_environment,
NILP (lex_bound) || EQ (lex_bound, Qunbound)
? Qnil : Fcons (Qt, Qnil));
(NILP (lex_bound) || EQ (lex_bound, Qunbound)
? Qnil : list1 (Qt)));
GCPRO4 (sourcename, readfun, start, end);
@ -2724,7 +2723,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (c == '$')
return Vload_file_name;
if (c == '\'')
return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
return list2 (Qfunction, read0 (readcharfun));
/* #:foo is the uninterned symbol named foo. */
if (c == ':')
{
@ -2819,9 +2818,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
goto retry;
case '\'':
{
return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
}
return list2 (Qquote, read0 (readcharfun));
case '`':
{
@ -2851,7 +2848,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
value = read0 (readcharfun);
new_backquote_flag = saved_new_backquote_flag;
return Fcons (Qbackquote, Fcons (value, Qnil));
return list2 (Qbackquote, value);
}
}
case ',':
@ -2889,7 +2886,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
}
value = read0 (readcharfun);
return Fcons (comma_type, Fcons (value, Qnil));
return list2 (comma_type, value);
}
else
{
@ -3665,7 +3662,7 @@ read_list (bool flag, Lisp_Object readcharfun)
}
invalid_syntax ("] in a list");
}
tem = Fcons (elt, Qnil);
tem = list1 (elt);
if (!NILP (tail))
XSETCDR (tail, tem);
else
@ -4232,7 +4229,7 @@ init_lread (void)
points to the eventual installed lisp, leim
directories. We should not use those now, even
if they exist, so start over from a clean slate. */
Vload_path = Fcons (tem, Qnil);
Vload_path = list1 (tem);
}
}
else
@ -4459,8 +4456,8 @@ otherwise to default specified by file `epaths.h' when Emacs was built. */);
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
Vload_suffixes = Fcons (build_pure_c_string (".elc"),
Fcons (build_pure_c_string (".el"), Qnil));
Vload_suffixes = list2 (build_pure_c_string (".elc"),
build_pure_c_string (".el"));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
@ -4474,7 +4471,7 @@ and, if so, which suffixes they should try to append to the file name
in order to do so. However, if you want to customize which suffixes
the loading functions recognize as compression suffixes, you should
customize `jka-compr-load-suffixes' rather than the present variable. */);
Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
Vload_file_rep_suffixes = list1 (empty_unibyte_string);
DEFVAR_BOOL ("load-in-progress", load_in_progress,
doc: /* Non-nil if inside of `load'. */);

3
src/macros.c
View file

@ -279,7 +279,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
/* Restore Vexecuting_kbd_macro and executing_kbd_macro_index.
Called when the unwind-protect in Fexecute_kbd_macro gets invoked. */
static Lisp_Object
static void
pop_kbd_macro (Lisp_Object info)
{
Lisp_Object tem;
@ -288,7 +288,6 @@ pop_kbd_macro (Lisp_Object info)
executing_kbd_macro_index = XINT (XCAR (tem));
Vreal_this_command = XCDR (tem);
Frun_hooks (1, &Qkbd_macro_termination_hook);
return Qnil;
}
DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0,

24
src/menu.c
View file

@ -102,10 +102,10 @@ finish_menu_items (void)
{
}
Lisp_Object
unuse_menu_items (Lisp_Object dummy)
void
unuse_menu_items (void)
{
return menu_items_inuse = Qnil;
menu_items_inuse = Qnil;
}
/* Call when finished using the data for the current menu
@ -124,19 +124,10 @@ discard_menu_items (void)
eassert (NILP (menu_items_inuse));
}
#ifdef HAVE_NS
static Lisp_Object
cleanup_popup_menu (Lisp_Object arg)
{
discard_menu_items ();
return Qnil;
}
#endif
/* This undoes save_menu_items, and it is called by the specpdl unwind
mechanism. */
static Lisp_Object
static void
restore_menu_items (Lisp_Object saved)
{
menu_items = XCAR (saved);
@ -148,7 +139,6 @@ restore_menu_items (Lisp_Object saved)
menu_items_n_panes = XINT (XCAR (saved));
saved = XCDR (saved);
menu_items_submenu_depth = XINT (XCAR (saved));
return Qnil;
}
/* Push the whole state of menu_items processing onto the specpdl.
@ -1004,7 +994,7 @@ find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data)
{
int j;
entry = Fcons (entry, Qnil);
entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
for (j = submenu_depth - 1; j >= 0; j--)
@ -1213,7 +1203,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#endif /* HAVE_MENUS */
/* Now parse the lisp menus. */
record_unwind_protect (unuse_menu_items, Qnil);
record_unwind_protect_void (unuse_menu_items);
title = Qnil;
GCPRO1 (title);
@ -1315,7 +1305,7 @@ no quit occurs and `x-popup-menu' returns nil. */)
#endif
#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */
record_unwind_protect (cleanup_popup_menu, Qnil);
record_unwind_protect_void (discard_menu_items);
#endif
/* Display them in a menu. */

40
src/minibuf.c
View file

@ -137,13 +137,6 @@ choose_minibuf_frame (void)
}
}
static Lisp_Object
choose_minibuf_frame_1 (Lisp_Object ignore)
{
choose_minibuf_frame ();
return Qnil;
}
DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
Sactive_minibuffer_window, 0, 0, 0,
doc: /* Return the currently active minibuffer window, or nil if none. */)
@ -171,8 +164,8 @@ without invoking the usual minibuffer commands. */)
/* Actual minibuffer invocation. */
static Lisp_Object read_minibuf_unwind (Lisp_Object);
static Lisp_Object run_exit_minibuf_hook (Lisp_Object);
static void read_minibuf_unwind (void);
static void run_exit_minibuf_hook (void);
/* Read a Lisp object from VAL and return it. If VAL is an empty
@ -474,20 +467,20 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Prepare for restoring the current buffer since choose_minibuf_frame
calling Fset_frame_selected_window may change it (Bug#12766). */
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
record_unwind_protect (restore_buffer, Fcurrent_buffer ());
choose_minibuf_frame ();
record_unwind_protect (choose_minibuf_frame_1, Qnil);
record_unwind_protect_void (choose_minibuf_frame);
record_unwind_protect (Fset_window_configuration,
record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (Qnil));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (!EQ (mini_frame, selected_frame))
record_unwind_protect (Fset_window_configuration,
record_unwind_protect (restore_window_configuration,
Fcurrent_window_configuration (mini_frame));
/* If the minibuffer is on an iconified or invisible frame,
@ -518,14 +511,14 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Fcons (Vminibuffer_history_variable,
minibuf_save_list))))));
record_unwind_protect (read_minibuf_unwind, Qnil);
record_unwind_protect_void (read_minibuf_unwind);
minibuf_level++;
/* We are exiting the minibuffer one way or the other, so run the hook.
It should be run before unwinding the minibuf settings. Do it
separately from read_minibuf_unwind because we need to make sure that
read_minibuf_unwind is fully executed even if exit-minibuffer-hook
signals an error. --Stef */
record_unwind_protect (run_exit_minibuf_hook, Qnil);
record_unwind_protect_void (run_exit_minibuf_hook);
/* Now that we can restore all those variables, start changing them. */
@ -786,7 +779,7 @@ get_minibuffer (EMACS_INT depth)
tail = Fnthcdr (num, Vminibuffer_list);
if (NILP (tail))
{
tail = Fcons (Qnil, Qnil);
tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
}
buf = Fcar (tail);
@ -821,18 +814,17 @@ get_minibuffer (EMACS_INT depth)
return buf;
}
static Lisp_Object
run_exit_minibuf_hook (Lisp_Object data)
static void
run_exit_minibuf_hook (void)
{
safe_run_hooks (Qminibuffer_exit_hook);
return Qnil;
}
/* This function is called on exiting minibuffer, whether normally or
not, and it restores the current window, buffer, etc. */
static Lisp_Object
read_minibuf_unwind (Lisp_Object data)
static void
read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
Lisp_Object window;
@ -895,7 +887,6 @@ read_minibuf_unwind (Lisp_Object data)
to make sure we don't leave around bindings and stuff which only
made sense during the read_minibuf invocation. */
call0 (intern ("minibuffer-inactive-mode"));
return Qnil;
}
@ -1862,7 +1853,7 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke
else if (EQ (flag, Qlambda))
return Ftest_completion (string, Vbuffer_alist, predicate);
else if (EQ (flag, Qmetadata))
return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil));
return list2 (Qmetadata, Fcons (Qcategory, Qbuffer));
else
return Qnil;
}
@ -2106,8 +2097,7 @@ These are in addition to the basic `field' property, and stickiness
properties. */);
/* We use `intern' here instead of Qread_only to avoid
initialization-order problems. */
Vminibuffer_prompt_properties
= Fcons (intern_c_string ("read-only"), Fcons (Qt, Qnil));
Vminibuffer_prompt_properties = list2 (intern_c_string ("read-only"), Qt);
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);

11
src/nsfns.m
View file

@ -981,7 +981,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
/* Handler for signals raised during x_create_frame.
FRAME is the frame which is partially constructed. */
static Lisp_Object
static void
unwind_create_frame (Lisp_Object frame)
{
struct frame *f = XFRAME (frame);
@ -990,7 +990,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
display is disconnected after the frame has become official, but
before x_create_frame removes the unwind protect. */
if (!FRAME_LIVE_P (f))
return Qnil;
return;
/* If frame is ``official'', nothing to do. */
if (NILP (Fmemq (frame, Vframe_list)))
@ -1006,10 +1006,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
/* Check that reference counts are indeed correct. */
eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount);
#endif
return Qt;
}
return Qnil;
}
/*
@ -2022,7 +2019,7 @@ and GNUstep implementations ("distributor-specific release
ns_string_to_pasteboard (pb, send);
if (NSPerformService (svcName, pb) == NO)
Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil));
Fsignal (Qquit, list1 (build_string ("service not available")));
if ([[pb types] count] == 0)
return build_string ("");
@ -2878,7 +2875,7 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
When you miniaturize a Group, Summary or Article frame, Gnus.tiff will
be used as the image of the icon representing the frame. */);
Vns_icon_type_alist = Fcons (Qt, Qnil);
Vns_icon_type_alist = list1 (Qt);
DEFVAR_LISP ("ns-version-string", Vns_version_string,
doc: /* Toolkit version for NS Windowing. */);

2
src/nsfont.m
View file

@ -446,7 +446,7 @@ but also for ascii (which causes unnecessary font substitution). */
{
Lisp_Object ranges, range_list;
ranges = Fcons (script, Qnil);
ranges = list1 (script);
map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
ranges);
range_list = Fnreverse (XCDR (ranges));

12
src/nsmenu.m
View file

@ -1410,10 +1410,10 @@ - (NSRect) frame
EmacsDialogPanel *dialog;
};
static Lisp_Object
pop_down_menu (Lisp_Object arg)
static void
pop_down_menu (void *arg)
{
struct Popdown_data *unwind_data = XSAVE_POINTER (arg, 0);
struct Popdown_data *unwind_data = arg;
block_input ();
if (popup_activated_flag)
@ -1427,8 +1427,6 @@ - (NSRect) frame
xfree (unwind_data);
unblock_input ();
return Qnil;
}
@ -1492,7 +1490,7 @@ - (NSRect) frame
if (NILP (Fcar (Fcdr (contents))))
/* No buttons specified, add an "Ok" button so users can pop down
the dialog. */
contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
contents = list2 (title, Fcons (build_string ("Ok"), Qt));
block_input ();
pool = [[NSAutoreleasePool alloc] init];
@ -1506,7 +1504,7 @@ - (NSRect) frame
unwind_data->pool = pool;
unwind_data->dialog = dialog;
record_unwind_protect (pop_down_menu, make_save_pointer (unwind_data));
record_unwind_protect_ptr (pop_down_menu, unwind_data);
popup_activated_flag = 1;
tem = [dialog runDialogAt: p];
unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */

16
src/nsselect.m
View file

@ -219,9 +219,10 @@ Updated by Christian Limpach (chris@nice.ch)
return value;
// FIXME: Why `quit' rather than `error'?
Fsignal (Qquit, Fcons (build_string (
"invalid data returned by selection-conversion function"),
Fcons (handler_fn, Fcons (value, Qnil))));
Fsignal (Qquit,
list3 (build_string ("invalid data returned by"
" selection-conversion function"),
handler_fn, value));
// FIXME: Beware, `quit' can return!!
return Qnil;
}
@ -256,8 +257,7 @@ Updated by Christian Limpach (chris@nice.ch)
if (type == nil)
{
Fsignal (Qquit,
Fcons (build_string ("empty or unsupported pasteboard type"),
Qnil));
list1 (build_string ("empty or unsupported pasteboard type")));
return Qnil;
}
@ -275,8 +275,8 @@ Updated by Christian Limpach (chris@nice.ch)
else
{
Fsignal (Qquit,
Fcons (build_string ("pasteboard doesn't contain valid data"),
Qnil));
list1 (build_string ("pasteboard doesn't contain"
" valid data")));
return Qnil;
}
}
@ -362,7 +362,7 @@ Updated by Christian Limpach (chris@nice.ch)
ns_declare_pasteboard (pb);
old_value = assq_no_quit (selection, Vselection_alist);
new_value = Fcons (selection, Fcons (value, Qnil));
new_value = list2 (selection, value);
if (NILP (old_value))
Vselection_alist = Fcons (new_value, Vselection_alist);

13
src/nsterm.m
View file

@ -362,7 +362,7 @@ Updated by Christian Limpach (chris@nice.ch)
{
Lisp_Object array[2];
array[0] = list;
array[1] = Fcons (item, Qnil);
array[1] = list1 (item);
return Fnconc (2, &array[0]);
}
@ -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
{
@ -4142,7 +4142,7 @@ static Lisp_Object ns_string_to_lispmod (const char *s)
if (selfds[0] == -1)
{
if (pipe2 (selfds, O_CLOEXEC) != 0)
if (emacs_pipe (selfds) != 0)
{
fprintf (stderr, "Failed to create pipe: %s\n",
emacs_strerror (errno));
@ -5746,9 +5746,10 @@ - (void)windowDidResignKey: (NSNotification *)notification
/* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */
{
struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe);
BOOL is_focus_frame = dpyinfo->x_focus_frame == emacsframe;
NSTRACE (windowDidResignKey);
if (dpyinfo->x_focus_frame == emacsframe)
if (is_focus_frame)
dpyinfo->x_focus_frame = 0;
ns_frame_rehighlight (emacsframe);
@ -5761,10 +5762,10 @@ - (void)windowDidResignKey: (NSNotification *)notification
x_set_frame_alpha (emacsframe);
}
if (emacs_event)
if (emacs_event && is_focus_frame)
{
[self deleteWorkingText];
emacs_event->kind = FOCUS_IN_EVENT;
emacs_event->kind = FOCUS_OUT_EVENT;
EV_TRAILER ((id)nil);
}
}

8
src/print.c
View file

@ -201,11 +201,10 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
static Lisp_Object
static void
print_unwind (Lisp_Object saved_text)
{
memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
return Qnil;
}
@ -772,8 +771,7 @@ append to existing target file. */)
{
stderr = initial_stderr_stream;
initial_stderr_stream = NULL;
report_file_error ("Cannot open debugging output stream",
Fcons (file, Qnil));
report_file_error ("Cannot open debugging output stream", file);
}
}
return Qnil;
@ -1303,7 +1301,7 @@ print_prune_string_charset (Lisp_Object string)
if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
{
if (NILP (print_prune_charset_plist))
print_prune_charset_plist = Fcons (Qcharset, Qnil);
print_prune_charset_plist = list1 (Qcharset);
Fremove_text_properties (make_number (0),
make_number (SCHARS (string)),
print_prune_charset_plist, string);

112
src/process.c
View file

@ -841,7 +841,7 @@ nil, indicating the current buffer's process. */)
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil)));
pset_status (p, list2 (Qexit, make_number (0)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
@ -1206,11 +1206,11 @@ list of keywords. */)
if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
return contact;
if (NILP (key) && NETCONN_P (process))
return Fcons (Fplist_get (contact, QChost),
Fcons (Fplist_get (contact, QCservice), Qnil));
return list2 (Fplist_get (contact, QChost),
Fplist_get (contact, QCservice));
if (NILP (key) && SERIALCONN_P (process))
return Fcons (Fplist_get (contact, QCport),
Fcons (Fplist_get (contact, QCspeed), Qnil));
return list2 (Fplist_get (contact, QCport),
Fplist_get (contact, QCspeed));
return Fplist_get (contact, key);
}
@ -1341,7 +1341,7 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
/* Starting asynchronous inferior processes. */
static Lisp_Object start_process_unwind (Lisp_Object proc);
static void start_process_unwind (Lisp_Object proc);
DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
doc: /* Start a program in a subprocess. Return the process object for it.
@ -1397,7 +1397,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
current_dir = expand_and_dir_to_file (current_dir, Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
report_file_error ("Setting current directory",
Fcons (BVAR (current_buffer, directory), Qnil));
BVAR (current_buffer, directory));
UNGCPRO;
}
@ -1519,7 +1519,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", Fcons (program, Qnil));
report_file_error ("Searching for program", program);
tem = Fexpand_file_name (tem, Qnil);
}
else
@ -1542,7 +1542,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
/* Encode the file name and put it in NEW_ARGV.
That's where the child will use it to execute the program. */
tem = Fcons (ENCODE_FILE (tem), Qnil);
tem = list1 (ENCODE_FILE (tem));
/* Here we encode arguments by the coding system used for sending
data to the process. We don't support using different coding
@ -1590,7 +1590,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
PROC doesn't have its pid set, then we know someone has signaled
an error and the process wasn't started successfully, so we should
remove it from the process list. */
static Lisp_Object
static void
start_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
@ -1600,8 +1600,6 @@ start_process_unwind (Lisp_Object proc)
-2 is used for a pty with no process, eg for gdb. */
if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
remove_process (proc);
return Qnil;
}
static void
@ -1651,11 +1649,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
else
#endif /* HAVE_PTYS */
{
if (pipe2 (sv, O_CLOEXEC) != 0)
if (emacs_pipe (sv) != 0)
report_file_error ("Creating pipe", Qnil);
inchannel = sv[0];
forkout = sv[1];
if (pipe2 (sv, O_CLOEXEC) != 0)
if (emacs_pipe (sv) != 0)
{
int pipe_errno = errno;
emacs_close (inchannel);
@ -1667,7 +1665,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
}
#ifndef WINDOWSNT
if (pipe2 (wait_child_setup, O_CLOEXEC) != 0)
if (emacs_pipe (wait_child_setup) != 0)
report_file_error ("Creating pipe", Qnil);
#endif
@ -2323,8 +2321,12 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
}
if (ret < 0)
report_file_error ("Cannot set network option",
Fcons (opt, Fcons (val, Qnil)));
{
int setsockopt_errno = errno;
report_file_errno ("Cannot set network option", list2 (opt, val),
setsockopt_errno);
}
return (1 << sopt->optbit);
}
@ -2456,16 +2458,6 @@ usage: (serial-process-configure &rest ARGS) */)
return Qnil;
}
/* Used by make-serial-process to recover from errors. */
static Lisp_Object
make_serial_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
emacs_abort ();
remove_process (proc);
return Qnil;
}
DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
0, MANY, 0,
doc: /* Create and return a serial port process.
@ -2571,10 +2563,10 @@ usage: (make-serial-process &rest ARGS) */)
CHECK_STRING (name);
proc = make_process (name);
specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (make_serial_process_unwind, proc);
record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
fd = serial_open (SSDATA (port));
fd = serial_open (port);
p->infd = fd;
p->outfd = fd;
if (fd > max_process_desc)
@ -3007,7 +2999,7 @@ usage: (make-network-process &rest ARGS) */)
#ifdef POLL_FOR_INPUT
if (socktype != SOCK_DGRAM)
{
record_unwind_protect (unwind_stop_other_atimers, Qnil);
record_unwind_protect_void (run_all_atimers);
bind_polling_period (10);
}
#endif
@ -3167,7 +3159,7 @@ usage: (make-network-process &rest ARGS) */)
#endif
/* Make us close S if quit. */
record_unwind_protect (close_file_unwind, make_number (s));
record_unwind_protect_int (close_file_unwind, s);
/* Parse network options in the arg list.
We simply ignore anything which isn't a known option (including other keywords).
@ -3258,16 +3250,16 @@ usage: (make-network-process &rest ARGS) */)
if (errno == EINTR)
goto retry_select;
else
report_file_error ("select failed", Qnil);
report_file_error ("Failed select", Qnil);
}
eassert (sc > 0);
len = sizeof xerrno;
eassert (FD_ISSET (s, &fdset));
if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
report_file_error ("getsockopt failed", Qnil);
report_file_error ("Failed getsockopt", Qnil);
if (xerrno)
report_file_errno ("error during connect", Qnil, xerrno);
report_file_errno ("Failed connect", Qnil, xerrno);
break;
}
#endif /* !WINDOWSNT */
@ -3534,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
{
@ -3553,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)
{
@ -3680,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;
@ -3694,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)
@ -3810,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) */
@ -3986,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);
@ -4008,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. */
@ -4124,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);
@ -4177,11 +4179,10 @@ server_accept_connection (Lisp_Object server, int channel)
when not inside wait_reading_process_output. */
static int waiting_for_user_input_p;
static Lisp_Object
wait_reading_process_output_unwind (Lisp_Object data)
static void
wait_reading_process_output_unwind (int data)
{
waiting_for_user_input_p = XINT (data);
return Qnil;
waiting_for_user_input_p = data;
}
/* This is here so breakpoints can be put on it. */
@ -4259,8 +4260,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (wait_proc != NULL)
wait_channel = wait_proc->infd;
record_unwind_protect (wait_reading_process_output_unwind,
make_number (waiting_for_user_input_p));
record_unwind_protect_int (wait_reading_process_output_unwind,
waiting_for_user_input_p);
waiting_for_user_input_p = read_kbd;
if (time_limit < 0)
@ -4625,7 +4626,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
else if (xerrno == EBADF)
emacs_abort ();
else
error ("select error: %s", emacs_strerror (xerrno));
report_file_errno ("Failed select", Qnil, xerrno);
}
if (no_avail)
@ -5124,9 +5125,7 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
sometimes it's simply wrong to wrap (e.g. when called from
accept-process-output). */
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (make_lisp_proc (p),
Fcons (text, Qnil))),
list3 (outstream, make_lisp_proc (p), text),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
read_process_output_error_handler);
@ -5296,7 +5295,7 @@ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
if (front)
pset_write_queue (p, Fcons (entry, p->write_queue));
else
pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil)));
pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
}
/* Remove the first element in the write_queue of process P, put its
@ -5469,7 +5468,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
if (rv >= 0)
written = rv;
else if (errno == EMSGSIZE)
report_file_error ("sending datagram", Fcons (proc, Qnil));
report_file_error ("Sending datagram", proc);
}
else
#endif
@ -5546,7 +5545,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
}
else
/* This is a real error. */
report_file_error ("writing to process", Fcons (proc, Qnil));
report_file_error ("Writing to process", proc);
}
cur_buf += written;
cur_len -= written;
@ -6040,7 +6039,7 @@ process has been transmitted to the serial port. */)
{
#ifndef WINDOWSNT
if (tcdrain (XPROCESS (proc)->outfd) != 0)
error ("tcdrain() failed: %s", emacs_strerror (errno));
report_file_error ("Failed tcdrain", Qnil);
#endif /* not WINDOWSNT */
/* Do nothing on Windows because writes are blocking. */
}
@ -6272,8 +6271,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason)
running_asynch_code = 1;
internal_condition_case_1 (read_process_output_call,
Fcons (sentinel,
Fcons (proc, Fcons (reason, Qnil))),
list3 (sentinel, proc, reason),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
exec_sentinel_error_handler);
@ -6737,7 +6735,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
if (xerrno == EINTR)
FD_ZERO (&waitchannels);
else
error ("select error: %s", emacs_strerror (xerrno));
report_file_errno ("Failed select", Qnil, xerrno);
}
/* Check for keyboard input */

4
src/search.c
View file

@ -3016,11 +3016,11 @@ restore_search_regs (void)
}
}
static Lisp_Object
static void
unwind_set_match_data (Lisp_Object list)
{
/* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */
return Fset_match_data (list, Qt);
Fset_match_data (list, Qt);
}
/* Called to unwind protect the match data. */

12
src/sound.c
View file

@ -437,10 +437,10 @@ find_sound_type (struct sound *s)
}
/* Function installed by play-sound-internal with record_unwind_protect. */
/* Function installed by play-sound-internal with record_unwind_protect_void. */
static Lisp_Object
sound_cleanup (Lisp_Object arg)
static void
sound_cleanup (void)
{
if (current_sound_device->close)
current_sound_device->close (current_sound_device);
@ -448,8 +448,6 @@ sound_cleanup (Lisp_Object arg)
emacs_close (current_sound->fd);
xfree (current_sound_device);
xfree (current_sound);
return Qnil;
}
/***********************************************************************
@ -1346,13 +1344,13 @@ Internal use only, use `play-sound' instead. */)
GCPRO2 (sound, file);
current_sound_device = xzalloc (sizeof *current_sound_device);
current_sound = xzalloc (sizeof *current_sound);
record_unwind_protect (sound_cleanup, Qnil);
record_unwind_protect_void (sound_cleanup);
current_sound->header = alloca (MAX_SOUND_HEADER_BYTES);
if (STRINGP (attrs[SOUND_FILE]))
{
/* Open the sound file. */
current_sound->fd = openp (Fcons (Vdata_directory, Qnil),
current_sound->fd = openp (list1 (Vdata_directory),
attrs[SOUND_FILE], Qnil, &file, Qnil);
if (current_sound->fd < 0)
sound_perror ("Could not open sound file");

324
src/sysdep.c
View file

@ -2201,6 +2201,20 @@ emacs_fopen (char const *file, char const *mode)
return fd < 0 ? 0 : fdopen (fd, mode);
}
/* Create a pipe for Emacs use. */
int
emacs_pipe (int fd[2])
{
int result = pipe2 (fd, O_CLOEXEC);
if (! O_CLOEXEC && result == 0)
{
fcntl (fd[0], F_SETFD, FD_CLOEXEC);
fcntl (fd[1], F_SETFD, FD_CLOEXEC);
}
return result;
}
/* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs.
For the background behind this mess, please see Austin Group defect 529
<http://austingroupbugs.net/view.php?id=529>. */
@ -2422,14 +2436,11 @@ safe_strsignal (int code)
#ifndef DOS_NT
/* For make-serial-process */
int
serial_open (char *port)
serial_open (Lisp_Object port)
{
int fd = emacs_open (port, O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
int fd = emacs_open (SSDATA (port), O_RDWR | O_NOCTTY | O_NONBLOCK, 0);
if (fd < 0)
{
error ("Could not open %s: %s",
port, emacs_strerror (errno));
}
report_file_error ("Opening serial port", port);
#ifdef TIOCEXCL
ioctl (fd, TIOCEXCL, (char *) 0);
#endif
@ -2477,7 +2488,7 @@ serial_configure (struct Lisp_Process *p,
/* Read port attributes and prepare default configuration. */
err = tcgetattr (p->outfd, &attr);
if (err != 0)
error ("tcgetattr() failed: %s", emacs_strerror (errno));
report_file_error ("Failed tcgetattr", Qnil);
cfmakeraw (&attr);
#if defined (CLOCAL)
attr.c_cflag |= CLOCAL;
@ -2494,8 +2505,7 @@ serial_configure (struct Lisp_Process *p,
CHECK_NUMBER (tem);
err = cfsetspeed (&attr, XINT (tem));
if (err != 0)
error ("cfsetspeed(%"pI"d) failed: %s", XINT (tem),
emacs_strerror (errno));
report_file_error ("Failed cfsetspeed", tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
/* Configure bytesize. */
@ -2617,7 +2627,7 @@ serial_configure (struct Lisp_Process *p,
/* Activate configuration. */
err = tcsetattr (p->outfd, TCSANOW, &attr);
if (err != 0)
error ("tcsetattr() failed: %s", emacs_strerror (errno));
report_file_error ("Failed tcsetattr", Qnil);
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
pset_childp (p, childp2);
@ -2797,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)
{
@ -2810,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))
@ -2839,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 ();
@ -2882,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;
@ -2893,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);
@ -2921,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;
@ -2949,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;
@ -3002,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);
@ -3029,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);
}
@ -3131,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);
@ -3159,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/systty.h
View file

@ -79,5 +79,5 @@ struct emacs_tty {
};
/* From sysdep.c or w32.c */
extern int serial_open (char *);
extern int serial_open (Lisp_Object);
extern void serial_configure (struct Lisp_Process *, Lisp_Object);

43
src/term.c
View file

@ -2416,15 +2416,20 @@ frame's terminal). */)
t->display_info.tty->input = stdin;
#else /* !MSDOS */
fd = emacs_open (t->display_info.tty->name, O_RDWR | O_NOCTTY, 0);
t->display_info.tty->input = t->display_info.tty->output
= fd < 0 ? 0 : fdopen (fd, "w+");
if (fd == -1)
error ("Can not reopen tty device %s: %s", t->display_info.tty->name, strerror (errno));
if (! t->display_info.tty->input)
{
int open_errno = errno;
emacs_close (fd);
report_file_errno ("Cannot reopen tty device",
build_string (t->display_info.tty->name),
open_errno);
}
if (!O_IGNORE_CTTY && strcmp (t->display_info.tty->name, DEV_TTY) != 0)
dissociate_if_controlling_tty (fd);
t->display_info.tty->output = fdopen (fd, "w+");
t->display_info.tty->input = t->display_info.tty->output;
#endif
add_keyboard_wait_descriptor (fd);
@ -2990,7 +2995,6 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
{
/* Open the terminal device. */
FILE *file;
/* If !ctty, don't recognize it as our controlling terminal, and
don't make it the controlling tty if we don't have one now.
@ -3001,30 +3005,21 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed)
open a frame on the same terminal. */
int flags = O_RDWR | O_NOCTTY | (ctty ? 0 : O_IGNORE_CTTY);
int fd = emacs_open (name, flags, 0);
tty->input = tty->output = fd < 0 || ! isatty (fd) ? 0 : fdopen (fd, "w+");
if (! tty->input)
{
char const *diagnostic
= tty->input ? "Not a tty device: %s" : "Could not open file: %s";
emacs_close (fd);
maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name);
}
tty->name = xstrdup (name);
terminal->name = xstrdup (name);
if (fd < 0)
maybe_fatal (must_succeed, terminal,
"Could not open file: %s",
"Could not open file: %s",
name);
if (!isatty (fd))
{
emacs_close (fd);
maybe_fatal (must_succeed, terminal,
"Not a tty device: %s",
"Not a tty device: %s",
name);
}
if (!O_IGNORE_CTTY && !ctty)
dissociate_if_controlling_tty (fd);
file = fdopen (fd, "w+");
tty->input = file;
tty->output = file;
}
tty->type = xstrdup (terminal_type);

2
src/termhooks.h
View file

@ -172,6 +172,8 @@ enum event_kind
`switch-frame' events in kbd_buffer_get_event, if necessary. */
FOCUS_IN_EVENT,
FOCUS_OUT_EVENT,
/* Generated when mouse moves over window not currently selected. */
SELECT_WINDOW_EVENT,

42
src/textprop.c
View file

@ -226,7 +226,7 @@ validate_plist (Lisp_Object list)
return list;
}
return Fcons (list, Fcons (Qnil, Qnil));
return list2 (list, Qnil);
}
/* Return true if interval I has all the properties,
@ -436,16 +436,14 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
if (set_type == TEXT_PROPERTY_PREPEND)
Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr)));
else
nconc2 (Fcar (this_cdr), Fcons (val1, Qnil));
nconc2 (Fcar (this_cdr), list1 (val1));
else {
/* The previous value is a single value, so make it
into a list. */
if (set_type == TEXT_PROPERTY_PREPEND)
Fsetcar (this_cdr,
Fcons (val1, Fcons (Fcar (this_cdr), Qnil)));
Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr)));
else
Fsetcar (this_cdr,
Fcons (Fcar (this_cdr), Fcons (val1, Qnil)));
Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1));
}
}
changed = 1;
@ -1308,9 +1306,7 @@ the current buffer), START and END are buffer positions (integers or
markers). If OBJECT is a string, START and END are 0-based indices into it. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object)
{
Fadd_text_properties (start, end,
Fcons (property, Fcons (value, Qnil)),
object);
Fadd_text_properties (start, end, list2 (property, value), object);
return Qnil;
}
@ -1344,11 +1340,10 @@ into it. */)
(Lisp_Object start, Lisp_Object end, Lisp_Object face,
Lisp_Object appendp, Lisp_Object object)
{
add_text_properties_1 (start, end,
Fcons (Qface, Fcons (face, Qnil)),
object,
NILP (appendp)? TEXT_PROPERTY_PREPEND:
TEXT_PROPERTY_APPEND);
add_text_properties_1 (start, end, list2 (Qface, face), object,
(NILP (appendp)
? TEXT_PROPERTY_PREPEND
: TEXT_PROPERTY_APPEND));
return Qnil;
}
@ -1929,7 +1924,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
{
if (EQ (Fcar (plist), prop))
{
plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
plist = list2 (prop, Fcar (Fcdr (plist)));
break;
}
plist = Fcdr (Fcdr (plist));
@ -1938,10 +1933,8 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_
{
/* Must defer modifications to the interval tree in case src
and dest refer to the same string or buffer. */
stuff = Fcons (Fcons (make_number (p),
Fcons (make_number (p + len),
Fcons (plist, Qnil))),
stuff);
stuff = Fcons (list3 (make_number (p), make_number (p + len), plist),
stuff);
}
i = next_interval (i);
@ -2007,14 +2000,13 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp
for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
if (EQ (XCAR (plist), prop))
{
plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
plist = list2 (prop, Fcar (XCDR (plist)));
break;
}
if (!NILP (plist))
result = Fcons (Fcons (make_number (s),
Fcons (make_number (s + len),
Fcons (plist, Qnil))),
result = Fcons (list3 (make_number (s), make_number (s + len),
plist),
result);
i = next_interval (i);
@ -2343,8 +2335,8 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and
/* Text properties `syntax-table'and `display' should be nonsticky
by default. */
Vtext_property_default_nonsticky
= Fcons (Fcons (intern_c_string ("syntax-table"), Qt),
Fcons (Fcons (intern_c_string ("display"), Qt), Qnil));
= list2 (Fcons (intern_c_string ("syntax-table"), Qt),
Fcons (intern_c_string ("display"), Qt));
staticpro (&interval_insert_behind_hooks);
staticpro (&interval_insert_in_front_hooks);

2
src/unexaix.c
View file

@ -97,7 +97,7 @@ report_error (const char *file, int fd)
int err = errno;
if (fd)
emacs_close (fd);
report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err);
report_file_errno ("Cannot unexec", build_string (file), err);
}
#define ERROR0(msg) report_error_1 (new, msg)

2
src/unexcoff.c
View file

@ -130,7 +130,7 @@ report_error (const char *file, int fd)
int err = errno;
if (fd)
emacs_close (fd);
report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err);
report_file_errno ("Cannot unexec", build_string (file), err);
}
#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1

2
src/unexsol.c
View file

@ -20,7 +20,7 @@ unexec (const char *new_name, const char *old_name)
if (! dldump (0, new_name, RTLD_MEMORY))
return;
data = Fcons (build_string (new_name), Qnil);
data = list1 (build_string (new_name));
synchronize_system_messages_locale ();
errstring = code_convert_string_norecord (build_string (dlerror ()),
Vlocale_coding_system, 0);

3
src/w32.c
View file

@ -7707,8 +7707,9 @@ globals_of_w32 (void)
/* For make-serial-process */
int
serial_open (char *port)
serial_open (Lisp_Object port_obj)
{
char *port = SSDATA (port_obj);
HANDLE hnd;
child_process *cp;
int fd = -1;

16
src/w32fns.c
View file

@ -318,7 +318,7 @@ x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc)
static Lisp_Object unwind_create_frame (Lisp_Object);
static Lisp_Object unwind_create_tip_frame (Lisp_Object);
static void unwind_create_tip_frame (Lisp_Object);
static void my_create_window (struct frame *);
static void my_create_tip_window (struct frame *);
@ -4258,6 +4258,12 @@ unwind_create_frame (Lisp_Object frame)
return Qnil;
}
static void
do_unwind_create_frame (Lisp_Object frame)
{
unwind_create_frame (frame);
}
static void
x_default_font_parameter (struct frame *f, Lisp_Object parms)
{
@ -4398,7 +4404,7 @@ This function is an internal primitive--use `make-frame' instead. */)
/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
/* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
record_unwind_protect (unwind_create_frame, frame);
record_unwind_protect (do_unwind_create_frame, frame);
#ifdef GLYPH_DEBUG
image_cache_refcount =
FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0;
@ -4910,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;
}
@ -5585,7 +5591,7 @@ Window tip_window;
Lisp_Object last_show_tip_args;
static Lisp_Object
static void
unwind_create_tip_frame (Lisp_Object frame)
{
Lisp_Object deleted;
@ -5596,8 +5602,6 @@ unwind_create_tip_frame (Lisp_Object frame)
tip_window = NULL;
tip_frame = Qnil;
}
return deleted;
}

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/window.c
View file

@ -3089,18 +3089,18 @@ run_funs (Lisp_Object funs)
call0 (XCAR (funs));
}
static Lisp_Object
static void
select_window_norecord (Lisp_Object window)
{
return WINDOW_LIVE_P (window)
? Fselect_window (window, Qt) : selected_window;
if (WINDOW_LIVE_P (window))
Fselect_window (window, Qt);
}
static Lisp_Object
static void
select_frame_norecord (Lisp_Object frame)
{
return FRAME_LIVE_P (XFRAME (frame))
? Fselect_frame (frame, Qt) : selected_frame;
if (FRAME_LIVE_P (XFRAME (frame)))
Fselect_frame (frame, Qt);
}
void
@ -3413,7 +3413,7 @@ temp_output_buffer_show (register Lisp_Object buf)
Note: Both Fselect_window and select_window_norecord may
set-buffer to the buffer displayed in the window,
so we need to save the current buffer. --stef */
record_unwind_protect (Fset_buffer, prev_buffer);
record_unwind_protect (restore_buffer, prev_buffer);
record_unwind_protect (select_window_norecord, prev_window);
Fselect_window (window, Qt);
Fset_buffer (w->contents);
@ -5879,6 +5879,12 @@ the return value is nil. Otherwise the value is t. */)
return (FRAME_LIVE_P (f) ? Qt : Qnil);
}
void
restore_window_configuration (Lisp_Object configuration)
{
Fset_window_configuration (configuration);
}
/* If WINDOW is an internal window, recursively delete all child windows
reachable via the next and contents slots of WINDOW. Otherwise setup

1
src/window.h
View file

@ -886,6 +886,7 @@ extern Lisp_Object make_window (void);
extern Lisp_Object window_from_coordinates (struct frame *, int, int,
enum window_part *, bool);
extern void resize_frame_windows (struct frame *, int, bool);
extern void restore_window_configuration (Lisp_Object);
extern void delete_all_child_windows (Lisp_Object);
extern void freeze_window_starts (struct frame *, bool);
extern void grow_mini_window (struct window *, int);

65
src/xdisp.c
View file

@ -817,21 +817,20 @@ static void handle_stop (struct it *);
static void handle_stop_backwards (struct it *, ptrdiff_t);
static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
static void ensure_echo_area_buffers (void);
static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object);
static void unwind_with_echo_area_buffer (Lisp_Object);
static Lisp_Object with_echo_area_buffer_unwind_data (struct window *);
static int with_echo_area_buffer (struct window *, int,
int (*) (ptrdiff_t, Lisp_Object),
ptrdiff_t, Lisp_Object);
static void clear_garbaged_frames (void);
static int current_message_1 (ptrdiff_t, Lisp_Object);
static void pop_message (void);
static int truncate_message_1 (ptrdiff_t, Lisp_Object);
static void set_message (Lisp_Object);
static int set_message_1 (ptrdiff_t, Lisp_Object);
static int display_echo_area (struct window *);
static int display_echo_area_1 (ptrdiff_t, Lisp_Object);
static int resize_mini_window_1 (ptrdiff_t, Lisp_Object);
static Lisp_Object unwind_redisplay (Lisp_Object);
static void unwind_redisplay (void);
static int string_char_and_length (const unsigned char *, int *);
static struct text_pos display_prop_end (struct it *, Lisp_Object,
struct text_pos);
@ -10202,7 +10201,7 @@ with_echo_area_buffer_unwind_data (struct window *w)
/* Restore global state from VECTOR which was created by
with_echo_area_buffer_unwind_data. */
static Lisp_Object
static void
unwind_with_echo_area_buffer (Lisp_Object vector)
{
set_buffer_internal_1 (XBUFFER (AREF (vector, 0)));
@ -10227,7 +10226,6 @@ unwind_with_echo_area_buffer (Lisp_Object vector)
}
Vwith_echo_area_save_vector = vector;
return Qnil;
}
@ -10626,20 +10624,12 @@ restore_message (void)
}
/* Handler for record_unwind_protect calling pop_message. */
/* Handler for unwind-protect calling pop_message. */
Lisp_Object
pop_message_unwind (Lisp_Object dummy)
{
pop_message ();
return Qnil;
}
/* Pop the top-most entry off Vmessage_stack. */
static void
pop_message (void)
void
pop_message_unwind (void)
{
/* Pop the top-most entry off Vmessage_stack. */
eassert (CONSP (Vmessage_stack));
Vmessage_stack = XCDR (Vmessage_stack);
}
@ -11035,7 +11025,7 @@ format_mode_line_unwind_data (struct frame *target_frame,
return vector;
}
static Lisp_Object
static void
unwind_format_mode_line (Lisp_Object vector)
{
Lisp_Object old_window = AREF (vector, 7);
@ -11078,7 +11068,6 @@ unwind_format_mode_line (Lisp_Object vector)
}
Vmode_line_unwind_vector = vector;
return Qnil;
}
@ -11527,7 +11516,7 @@ int last_tool_bar_item;
do_switch_frame.
FIXME: Maybe do_switch_frame should be trimmed down similarly
when `norecord' is set. */
static Lisp_Object
static void
fast_set_selected_frame (Lisp_Object frame)
{
if (!EQ (selected_frame, frame))
@ -11535,7 +11524,6 @@ fast_set_selected_frame (Lisp_Object frame)
selected_frame = frame;
selected_window = XFRAME (frame)->selected_window;
}
return Qnil;
}
/* Update the tool-bar item list for frame F. This has to be done
@ -12055,9 +12043,8 @@ redisplay_tool_bar (struct frame *f)
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame,
Fcons (Fcons (Qtool_bar_lines,
make_number (nlines)),
Qnil));
list1 (Fcons (Qtool_bar_lines,
make_number (nlines))));
if (WINDOW_TOTAL_LINES (w) != old_height)
{
clear_glyph_matrix (w->desired_matrix);
@ -12156,9 +12143,8 @@ redisplay_tool_bar (struct frame *f)
{
XSETFRAME (frame, f);
Fmodify_frame_parameters (frame,
Fcons (Fcons (Qtool_bar_lines,
make_number (nlines)),
Qnil));
list1 (Fcons (Qtool_bar_lines,
make_number (nlines))));
if (WINDOW_TOTAL_LINES (w) != old_height)
{
clear_glyph_matrix (w->desired_matrix);
@ -13038,7 +13024,7 @@ redisplay_internal (void)
/* Record a function that clears redisplaying_p
when we leave this function. */
count = SPECPDL_INDEX ();
record_unwind_protect (unwind_redisplay, selected_frame);
record_unwind_protect_void (unwind_redisplay);
redisplaying_p = 1;
specbind (Qinhibit_free_realized_faces, Qnil);
@ -13725,14 +13711,12 @@ redisplay_preserve_echo_area (int from_where)
}
/* Function registered with record_unwind_protect in redisplay_internal.
Clear redisplaying_p. Also select the previously selected frame. */
/* Function registered with record_unwind_protect in redisplay_internal. */
static Lisp_Object
unwind_redisplay (Lisp_Object old_frame)
static void
unwind_redisplay (void)
{
redisplaying_p = 0;
return Qnil;
}
@ -21452,7 +21436,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_st
if (NILP (face))
face = mode_line_string_face;
else
face = Fcons (face, Fcons (mode_line_string_face, Qnil));
face = list2 (face, mode_line_string_face);
props = Fplist_put (props, Qface, face);
}
Fadd_text_properties (make_number (0), make_number (len),
@ -21476,8 +21460,8 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_st
if (NILP (face))
face = mode_line_string_face;
else
face = Fcons (face, Fcons (mode_line_string_face, Qnil));
props = Fcons (Qface, Fcons (face, Qnil));
face = list2 (face, mode_line_string_face);
props = list2 (Qface, face);
if (copy_string)
lisp_string = Fcopy_sequence (lisp_string);
}
@ -21591,7 +21575,7 @@ are the selected window and the WINDOW's buffer). */)
mode_line_string_list = Qnil;
mode_line_string_face = face;
mode_line_string_face_prop
= (NILP (face) ? Qnil : Fcons (Qface, Fcons (face, Qnil)));
= NILP (face) ? Qnil : list2 (Qface, face);
}
push_kboard (FRAME_KBOARD (it.f));
@ -29488,9 +29472,8 @@ syms_of_xdisp (void)
DEFSYM (Qarrow, "arrow");
DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces");
list_of_error = Fcons (Fcons (intern_c_string ("error"),
Fcons (intern_c_string ("void-variable"), Qnil)),
Qnil);
list_of_error = list1 (list2 (intern_c_string ("error"),
intern_c_string ("void-variable")));
staticpro (&list_of_error);
DEFSYM (Qlast_arrow_position, "last-arrow-position");
@ -29594,7 +29577,7 @@ See also `overlay-arrow-position'. */);
The symbols on this list are examined during redisplay to determine
where to display overlay arrows. */);
Voverlay_arrow_variable_list
= Fcons (intern_c_string ("overlay-arrow-position"), Qnil);
= list1 (intern_c_string ("overlay-arrow-position"));
DEFVAR_INT ("scroll-step", emacs_scroll_step,
doc: /* The number of lines to try scrolling a window by when point moves out.

49
src/xfaces.c
View file

@ -3388,7 +3388,7 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface)
ASET (lface, LFACE_FONT_INDEX, font);
}
f->default_face_done_p = 0;
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil));
Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, font)));
}
}
@ -3709,14 +3709,10 @@ Value is nil if ATTR doesn't have a discrete set of valid values. */)
CHECK_SYMBOL (attr);
if (EQ (attr, QCunderline))
result = Fcons (Qt, Fcons (Qnil, Qnil));
else if (EQ (attr, QCoverline))
result = Fcons (Qt, Fcons (Qnil, Qnil));
else if (EQ (attr, QCstrike_through))
result = Fcons (Qt, Fcons (Qnil, Qnil));
else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
result = Fcons (Qt, Fcons (Qnil, Qnil));
if (EQ (attr, QCunderline) || EQ (attr, QCoverline)
|| EQ (attr, QCstrike_through)
|| EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video))
result = list2 (Qt, Qnil);
return result;
}
@ -3779,21 +3775,18 @@ Default face attributes override any local face attributes. */)
&& newface->font)
{
Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name),
Qnil));
Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, name)));
}
if (STRINGP (gvec[LFACE_FOREGROUND_INDEX]))
Fmodify_frame_parameters (frame,
Fcons (Fcons (Qforeground_color,
gvec[LFACE_FOREGROUND_INDEX]),
Qnil));
list1 (Fcons (Qforeground_color,
gvec[LFACE_FOREGROUND_INDEX])));
if (STRINGP (gvec[LFACE_BACKGROUND_INDEX]))
Fmodify_frame_parameters (frame,
Fcons (Fcons (Qbackground_color,
gvec[LFACE_BACKGROUND_INDEX]),
Qnil));
list1 (Fcons (Qbackground_color,
gvec[LFACE_BACKGROUND_INDEX])));
}
}
@ -6290,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)
{
@ -6297,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
@ -6483,7 +6472,7 @@ syms_of_xfaces (void)
DEFSYM (Qtty_color_alist, "tty-color-alist");
DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed");
Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil);
Vparam_value_alist = list1 (Fcons (Qnil, Qnil));
staticpro (&Vparam_value_alist);
Vface_alternative_font_family_alist = Qnil;
staticpro (&Vface_alternative_font_family_alist);

47
src/xfns.c
View file

@ -1715,7 +1715,7 @@ x_default_scroll_bar_color_parameter (struct frame *f,
#endif /* not USE_TOOLKIT_SCROLL_BARS */
}
x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
x_set_frame_parameters (f, list1 (Fcons (prop, tem)));
return tem;
}
@ -2883,11 +2883,16 @@ unwind_create_frame (Lisp_Object frame)
return Qnil;
}
static Lisp_Object
static void
do_unwind_create_frame (Lisp_Object frame)
{
unwind_create_frame (frame);
}
static void
unwind_create_frame_1 (Lisp_Object val)
{
inhibit_lisp_code = val;
return Qnil;
}
static void
@ -2948,7 +2953,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms)
{
/* Remember the explicit font parameter, so we can re-apply it after
we've applied the `default' face settings. */
x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil));
x_set_frame_parameters (f, list1 (Fcons (Qfont_param, font_param)));
}
/* This call will make X resources override any system font setting. */
@ -3090,7 +3095,7 @@ This function is an internal primitive--use `make-frame' instead. */)
FRAME_X_DISPLAY_INFO (f) = dpyinfo;
/* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */
record_unwind_protect (unwind_create_frame, frame);
record_unwind_protect (do_unwind_create_frame, frame);
/* These colors will be set anyway later, but it's important
to get the color reference counts right, so initialize them! */
@ -4975,7 +4980,7 @@ Window tip_window;
static Lisp_Object last_show_tip_args;
static Lisp_Object
static void
unwind_create_tip_frame (Lisp_Object frame)
{
Lisp_Object deleted;
@ -4986,8 +4991,6 @@ unwind_create_tip_frame (Lisp_Object frame)
tip_window = None;
tip_frame = Qnil;
}
return deleted;
}
@ -5238,7 +5241,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
Fmodify_frame_parameters (frame, list1 (Fcons (Qtooltip, Qt)));
/* FIXME - can this be done in a similar way to normal frames?
http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00641.html */
@ -5256,8 +5259,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
disptype = intern ("color");
if (NILP (Fframe_parameter (frame, Qdisplay_type)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qdisplay_type, disptype),
Qnil));
Fmodify_frame_parameters (frame, list1 (Fcons (Qdisplay_type, disptype)));
}
/* Set up faces after all frame parameters are known. This call
@ -5276,8 +5278,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
call2 (Qface_set_after_frame_default, frame, Qnil);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
Qnil));
Fmodify_frame_parameters (frame, list1 (Fcons (Qbackground_color, bg)));
}
f->no_split = 1;
@ -5766,10 +5767,10 @@ file_dialog_unmap_cb (Widget widget, XtPointer client_data, XtPointer call_data)
*result = XmCR_CANCEL;
}
static Lisp_Object
clean_up_file_dialog (Lisp_Object arg)
static void
clean_up_file_dialog (void *arg)
{
Widget dialog = XSAVE_POINTER (arg, 0);
Widget dialog = arg;
/* Clean up. */
block_input ();
@ -5777,8 +5778,6 @@ clean_up_file_dialog (Lisp_Object arg)
XtDestroyWidget (dialog);
x_menu_set_in_use (0);
unblock_input ();
return Qnil;
}
@ -5893,7 +5892,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
XmStringFree (default_xmstring);
}
record_unwind_protect (clean_up_file_dialog, make_save_pointer (dialog));
record_unwind_protect_ptr (clean_up_file_dialog, dialog);
/* Process events until the user presses Cancel or OK. */
x_menu_set_in_use (1);
@ -5947,12 +5946,10 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
#ifdef USE_GTK
static Lisp_Object
clean_up_dialog (Lisp_Object arg)
static void
clean_up_dialog (void)
{
x_menu_set_in_use (0);
return Qnil;
}
DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
@ -5986,7 +5983,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */)
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
record_unwind_protect (clean_up_dialog, Qnil);
record_unwind_protect_void (clean_up_dialog);
block_input ();
@ -6041,7 +6038,7 @@ nil, it defaults to the selected frame. */)
/* Prevent redisplay. */
specbind (Qinhibit_redisplay, Qt);
record_unwind_protect (clean_up_dialog, Qnil);
record_unwind_protect_void (clean_up_dialog);
block_input ();

4
src/xfont.c
View file

@ -295,9 +295,9 @@ xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props,
/* Two special cases to avoid opening rather big fonts. */
if (EQ (AREF (props, 2), Qja))
return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil));
return list2 (intern ("kana"), intern ("han"));
if (EQ (AREF (props, 2), Qko))
return Fcons (intern ("hangul"), Qnil);
return list1 (intern ("hangul"));
scripts = Fgethash (props, xfont_scripts_cache, Qt);
if (EQ (scripts, Qt))
{

55
src/xmenu.c
View file

@ -296,10 +296,10 @@ for instance using the window manager, then this produces a quit and
XSETFRAME (frame, f);
XSETINT (x, x_pixel_width (f) / 2);
XSETINT (y, x_pixel_height (f) / 2);
newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
newpos = list2 (list2 (x, y), frame);
return Fx_popup_menu (newpos,
Fcons (Fcar (contents), Fcons (contents, Qnil)));
list2 (Fcar (contents), contents));
}
#else
{
@ -311,15 +311,15 @@ for instance using the window manager, then this produces a quit and
/* Decode the dialog items from what was specified. */
title = Fcar (contents);
CHECK_STRING (title);
record_unwind_protect (unuse_menu_items, Qnil);
record_unwind_protect_void (unuse_menu_items);
if (NILP (Fcar (Fcdr (contents))))
/* No buttons specified, add an "Ok" button so users can pop down
the dialog. Also, the lesstif/motif version crashes if there are
no buttons. */
contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil));
contents = list2 (title, Fcons (build_string ("Ok"), Qt));
list_of_panes (Fcons (contents, Qnil));
list_of_panes (list1 (contents));
/* Display them in a dialog box. */
block_input ();
@ -1405,14 +1405,13 @@ popup_selection_callback (GtkWidget *widget, gpointer client_data)
if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data;
}
static Lisp_Object
pop_down_menu (Lisp_Object arg)
static void
pop_down_menu (void *arg)
{
popup_activated_flag = 0;
block_input ();
gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg, 0)));
gtk_widget_destroy (GTK_WIDGET (arg));
unblock_input ();
return Qnil;
}
/* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
@ -1474,7 +1473,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y,
gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i,
timestamp ? timestamp : gtk_get_current_event_time ());
record_unwind_protect (pop_down_menu, make_save_pointer (menu));
record_unwind_protect_ptr (pop_down_menu, menu);
if (gtk_widget_get_mapped (menu))
{
@ -1513,7 +1512,7 @@ popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data)
/* ARG is the LWLIB ID of the dialog box, represented
as a Lisp object as (HIGHPART . LOWPART). */
static Lisp_Object
static void
pop_down_menu (Lisp_Object arg)
{
LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID)
@ -1523,8 +1522,6 @@ pop_down_menu (Lisp_Object arg)
lw_destroy_all_widgets (id);
unblock_input ();
popup_activated_flag = 0;
return Qnil;
}
/* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
@ -1604,11 +1601,10 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
#endif /* not USE_GTK */
static Lisp_Object
cleanup_widget_value_tree (Lisp_Object arg)
static void
cleanup_widget_value_tree (void *arg)
{
free_menubar_widget_value_tree (XSAVE_POINTER (arg, 0));
return Qnil;
free_menubar_widget_value_tree (arg);
}
Lisp_Object
@ -1822,8 +1818,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
/* Make sure to free the widget_value objects we used to specify the
contents even with longjmp. */
record_unwind_protect (cleanup_widget_value_tree,
make_save_pointer (first_wv));
record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv);
/* Actually create and show the menu until popped down. */
create_and_show_popup_menu (f, first_wv, x, y, for_click, timestamp);
@ -1871,7 +1866,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
{
int j;
entry = Fcons (entry, Qnil);
entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
for (j = submenu_depth - 1; j >= 0; j--)
@ -1922,7 +1917,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv)
if (menu)
{
ptrdiff_t specpdl_count = SPECPDL_INDEX ();
record_unwind_protect (pop_down_menu, make_save_pointer (menu));
record_unwind_protect_ptr (pop_down_menu, menu);
/* Display the menu. */
gtk_widget_show_all (menu);
@ -2132,8 +2127,7 @@ xdialog_show (FRAME_PTR f,
/* Make sure to free the widget_value objects we used to specify the
contents even with longjmp. */
record_unwind_protect (cleanup_widget_value_tree,
make_save_pointer (first_wv));
record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv);
/* Actually create and show the dialog. */
create_and_show_dialog (f, first_wv);
@ -2172,7 +2166,7 @@ xdialog_show (FRAME_PTR f,
{
if (keymaps != 0)
{
entry = Fcons (entry, Qnil);
entry = list1 (entry);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
}
@ -2223,14 +2217,12 @@ menu_help_callback (char const *help_string, int pane, int item)
pane_name = first_item[MENU_ITEMS_ITEM_NAME];
/* (menu-item MENU-NAME PANE-NUMBER) */
menu_object = Fcons (Qmenu_item,
Fcons (pane_name,
Fcons (make_number (pane), Qnil)));
menu_object = list3 (Qmenu_item, pane_name, make_number (pane));
show_help_echo (help_string ? build_string (help_string) : Qnil,
Qnil, menu_object, make_number (item));
}
static Lisp_Object
static void
pop_down_menu (Lisp_Object arg)
{
FRAME_PTR f = XSAVE_POINTER (arg, 0);
@ -2257,8 +2249,6 @@ pop_down_menu (Lisp_Object arg)
#endif /* HAVE_X_WINDOWS */
unblock_input ();
return Qnil;
}
@ -2475,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. */
@ -2515,7 +2504,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps,
= AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
if (keymaps)
{
entry = Fcons (entry, Qnil);
entry = list1 (entry);
if (!NILP (pane_prefix))
entry = Fcons (pane_prefix, entry);
}

2
src/xml.c
View file

@ -124,7 +124,7 @@ make_dom (xmlNode *node)
{
if (node->type == XML_ELEMENT_NODE)
{
Lisp_Object result = Fcons (intern ((char *) node->name), Qnil);
Lisp_Object result = list1 (intern ((char *) node->name));
xmlNode *child;
xmlAttr *property;
Lisp_Object plist = Qnil;

53
src/xselect.c
View file

@ -45,26 +45,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
struct prop_location;
struct selection_data;
static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object);
static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int,
struct x_display_info *);
static void x_decline_selection_request (struct input_event *);
static Lisp_Object x_selection_request_lisp_error (Lisp_Object);
static Lisp_Object queue_selection_requests_unwind (Lisp_Object);
static Lisp_Object x_catch_errors_unwind (Lisp_Object);
static void x_reply_selection_request (struct input_event *, struct x_display_info *);
static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
Atom, int, struct x_display_info *);
static int waiting_for_other_props_on_window (Display *, Window);
static struct prop_location *expect_property_change (Display *, Window,
Atom, int);
static void unexpect_property_change (struct prop_location *);
static Lisp_Object wait_for_property_change_unwind (Lisp_Object);
static void wait_for_property_change (struct prop_location *);
static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
static Lisp_Object x_get_window_property_as_lisp_data (Display *,
Window, Atom,
Lisp_Object, Atom);
@ -74,7 +62,6 @@ static Lisp_Object selection_data_to_lisp_data (Display *,
static void lisp_data_to_selection_data (Display *, Lisp_Object,
unsigned char **, Atom *,
ptrdiff_t *, int *, int *);
static Lisp_Object clean_local_selection_data (Lisp_Object);
/* Printing traces to stderr. */
@ -513,8 +500,8 @@ static Atom conversion_fail_tag;
an error, we tell the requestor that we were unable to do what they wanted
before we throw to top-level or go into the debugger or whatever. */
static Lisp_Object
x_selection_request_lisp_error (Lisp_Object ignore)
static void
x_selection_request_lisp_error (void)
{
struct selection_data *cs, *next;
@ -530,16 +517,14 @@ x_selection_request_lisp_error (Lisp_Object ignore)
if (x_selection_current_request != 0
&& selection_request_dpyinfo->display)
x_decline_selection_request (x_selection_current_request);
return Qnil;
}
static Lisp_Object
x_catch_errors_unwind (Lisp_Object dummy)
static void
x_catch_errors_unwind (void)
{
block_input ();
x_uncatch_errors ();
unblock_input ();
return Qnil;
}
@ -560,11 +545,6 @@ struct prop_location
struct prop_location *next;
};
static struct prop_location *expect_property_change (Display *display, Window window, Atom property, int state);
static void wait_for_property_change (struct prop_location *location);
static void unexpect_property_change (struct prop_location *location);
static int waiting_for_other_props_on_window (Display *display, Window window);
static int prop_location_identifier;
static Lisp_Object property_change_reply;
@ -573,13 +553,6 @@ static struct prop_location *property_change_reply_object;
static struct prop_location *property_change_wait_list;
static Lisp_Object
queue_selection_requests_unwind (Lisp_Object tem)
{
x_stop_queuing_selection_requests ();
return Qnil;
}
/* Send the reply to a selection request event EVENT. */
@ -614,7 +587,7 @@ x_reply_selection_request (struct input_event *event,
/* The protected block contains wait_for_property_change, which can
run random lisp code (process handlers) or signal. Therefore, we
put the x_uncatch_errors call in an unwind. */
record_unwind_protect (x_catch_errors_unwind, Qnil);
record_unwind_protect_void (x_catch_errors_unwind);
x_catch_errors (display);
/* Loop over converted selections, storing them in the requested
@ -805,12 +778,12 @@ x_handle_selection_request (struct input_event *event)
x_selection_current_request = event;
selection_request_dpyinfo = dpyinfo;
record_unwind_protect (x_selection_request_lisp_error, Qnil);
record_unwind_protect_void (x_selection_request_lisp_error);
/* We might be able to handle nested x_handle_selection_requests,
but this is difficult to test, and seems unimportant. */
x_start_queuing_selection_requests ();
record_unwind_protect (queue_selection_requests_unwind, Qnil);
record_unwind_protect_void (x_stop_queuing_selection_requests);
TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
SDATA (SYMBOL_NAME (selection_symbol)),
@ -1117,15 +1090,14 @@ unexpect_property_change (struct prop_location *location)
/* Remove the property change expectation element for IDENTIFIER. */
static Lisp_Object
wait_for_property_change_unwind (Lisp_Object loc)
static void
wait_for_property_change_unwind (void *loc)
{
struct prop_location *location = XSAVE_POINTER (loc, 0);
struct prop_location *location = loc;
unexpect_property_change (location);
if (location == property_change_reply_object)
property_change_reply_object = 0;
return Qnil;
}
/* Actually wait for a property change.
@ -1140,8 +1112,7 @@ wait_for_property_change (struct prop_location *location)
emacs_abort ();
/* Make sure to do unexpect_property_change if we quit or err. */
record_unwind_protect (wait_for_property_change_unwind,
make_save_pointer (location));
record_unwind_protect_ptr (wait_for_property_change_unwind, location);
XSETCAR (property_change_reply, Qnil);
property_change_reply_object = location;
@ -1254,7 +1225,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
SelectionNotify. */
#if 0
x_start_queuing_selection_requests ();
record_unwind_protect (queue_selection_requests_unwind, Qnil);
record_unwind_protect_void (x_stop_queuing_selection_requests);
#endif
unblock_input ();

Some files were not shown because too many files have changed in this diff Show more