[COMMIT] Get case-insensitive packages working, test this functionality.
5 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1556446900 -3600
# Sun Apr 28 11:21:40 2019 +0100
# Node ID 3db0ed5a2a43c15fb3801b1478b9e3d9bae152b0
# Parent cb4fc60aef1a2383a93dbd971410a14d4ef29891
Get case-insensitive packages working, test this functionality.
src/ChangeLog addition:
2019-04-23 Aidan Kehoe <kehoea(a)parhasard.net>
* elhash.c (syms_of_elhash):
staticpro() Vequalp_hash_table_test, necessary for interning into
a hash table having test #'equalp to actually work.
tests/ChangeLog addition:
2019-04-28 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/symbol-tests.el (Check-package-case-sensitivity):
Supply tests to check that case-insensitive packages work with
#'intern, #'intern-soft.
diff -r cb4fc60aef1a -r 3db0ed5a2a43 src/ChangeLog
--- a/src/ChangeLog Sat Apr 27 13:16:28 2019 +0200
+++ b/src/ChangeLog Sun Apr 28 11:21:40 2019 +0100
＠＠ -1,3 +1,9 ＠＠
+2019-04-23 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * elhash.c (syms_of_elhash):
+ staticpro() Vequalp_hash_table_test, necessary for interning into
+ a hash table having test #'equalp to actually work.
+
2019-04-22 Aidan Kehoe <kehoea(a)parhasard.net>
* process.c (getenv_internal):
diff -r cb4fc60aef1a -r 3db0ed5a2a43 src/elhash.c
--- a/src/elhash.c Sat Apr 27 13:16:28 2019 +0200
+++ b/src/elhash.c Sun Apr 28 11:21:40 2019 +0100
＠＠ -2854,6 +2854,7 ＠＠
= Fcons (Fcons (Qequal, Vequal_hash_table_test),
XWEAK_LIST_LIST (Vhash_table_test_weak_list));
+ staticpro (&Vequalp_hash_table_test);
Vequalp_hash_table_test
= define_hash_table_test (Qequalp, lisp_object_equalp_equal,
lisp_object_equalp_hash, Qequalp, Qequalp_hash);
diff -r cb4fc60aef1a -r 3db0ed5a2a43 tests/ChangeLog
--- a/tests/ChangeLog Sat Apr 27 13:16:28 2019 +0200
+++ b/tests/ChangeLog Sun Apr 28 11:21:40 2019 +0100
＠＠ -1,3 +1,9 ＠＠
+2019-04-28 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/symbol-tests.el (Check-package-case-sensitivity):
+ Supply tests to check that case-insensitive packages work with
+ #'intern, #'intern-soft.
+
2018-09-28 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r cb4fc60aef1a -r 3db0ed5a2a43 tests/automated/symbol-tests.el
--- a/tests/automated/symbol-tests.el Sat Apr 27 13:16:28 2019 +0200
+++ b/tests/automated/symbol-tests.el Sun Apr 28 11:21:40 2019 +0100
＠＠ -66,6 +66,105 ＠＠
(Assert (not (eq interned uninterned)))
(Assert (not (equal interned uninterned)))))
+(macrolet
+ ((Check-package-case-sensitivity (&rest names)
+ (cons
+ 'progn
+ (mapcan
+ #'(lambda (name)
+ (block done
+ (if (eq 'decode-coding-string (car-safe name))
+ (if (featurep 'mule)
+ (setq name (eval name))
+ ;; Can't handle this string on non-mule:
+ (return-from done nil)))
+ (let ((name-upper (upcase name))
+ (name-lower (downcase name))
+ (name-titlecase (upcase-initials name)))
+ `((Assert (not (eq (intern ,name sensitive)
+ (intern ,name insensitive)))
+ ,(concat "Checking `" name
+ "' interns as distinct symbols in "
+ "distinct packages"))
+ ,＠(unless
+ (equal name name-upper)
+ `((Assert (eq (intern ,name insensitive)
+ (intern ,name-upper insensitive))
+ ,(concat "Checking `" name
+ "' and `" name-upper
+ "' map to the same symbol, "
+ "case-insensitive package"))
+ (Assert (eq (intern-soft ,name-upper sensitive pi)
+ pi)
+ ,(concat "Checking `" name-upper
+ "' not yet interned in the "
+ "case-sensitive package"))
+ (Assert (not (eq (intern ,name sensitive)
+ (intern ,name-upper sensitive)))
+ ,(concat "Checking `" name
+ "' and `" name-upper
+ "' map to distinct symbols, "
+ "case-sensitive package"))))
+ ,＠(unless
+ (equal name name-lower)
+ `((Assert (eq (intern ,name insensitive)
+ (intern ,name-lower insensitive))
+ ,(concat "Checking `" name
+ "' and `" name-lower
+ "' map to the same symbol, "
+ "case-insensitive package"))
+ (Assert (eq (intern-soft ,name-lower sensitive pi)
+ pi)
+ ,(concat "Checking `" name-lower
+ "' not yet interned in the "
+ "case-sensitive package"))
+ (Assert (not (eq (intern ,name sensitive)
+ (intern ,name-lower sensitive)))
+ ,(concat "Checking `" name
+ "' and `" name-lower
+ "' map to distinct symbols, "
+ "case-sensitive package"))))
+ ,＠(unless
+ (equal name name-titlecase)
+ `((Assert (eq (intern ,name insensitive)
+ (intern ,name-titlecase insensitive))
+ ,(concat "Checking `" name
+ "' and `" name-titlecase
+ "' map to the same symbol, "
+ "case-insensitive package"))
+ (Assert (eq (intern-soft ,name-titlecase sensitive pi)
+ pi)
+ ,(concat "Checking `" name-titlecase
+ "' not yet interned in the "
+ "case-sensitive package"))
+ (Assert (not (eq (intern ,name sensitive)
+ (intern ,name-titlecase sensitive)))
+ ,(concat "Checking `" name
+ "' and `" name-titlecase
+ "' map to distinct symbols, "
+ "case-sensitive package"))))))))
+ names))))
+ (let ((insensitive (make-hash-table :test #'equalp))
+ (sensitive (make-hash-table :test #'equal)))
+ (Check-package-case-sensitivity
+ "foo" "bar" "" "something with space in it"
+ "a string with \0 in the middle." "100" "10.0" "#<>[]]]];'\\';"
+ ;; "καρδιακή"
+ (decode-coding-string
+ "\xce\xba\xce\xb1\xcf\x81\xce\xb4\xce\xb9\xce\xb1\xce\xba\xce\xae"
+ 'utf-8)
+ ;; ", κοινώς γνωστό ως καρδιακή προσβολή, "
+ (decode-coding-string
+ "\x2c\x20\xce\xba\xce\xbf\xce\xb9\xce\xbd\xcf\x8e\xcf\x82\x20\xce\xb3\xce\xbd\xcf\x89\xcf\x83\xcf\x84\xcf\x8c\x20\xcf\x89\xcf\x82\x20\xce\xba\xce\xb1\xcf\x81\xce\xb4\xce\xb9\xce\xb1\xce\xba\xce\xae\x20\xcf\x80\xcf\x81\xce\xbf\xcf\x83\xce\xb2\xce\xbf\xce\xbb\xce\xae\x2c\x20"
+ 'utf-8)
+ "!＠#$%^^&*(()__"
+ ;; "Иногда"
+ (decode-coding-string "\xd0\x98\xd0\xbd\xd0\xbe\xd0\xb3\xd0\xb4\xd0\xb0"
+ 'utf-8)
+ ;; "цианокобаламин, так как именно"
+ (decode-coding-string "\xd1\x86\xd0\xb8\xd0\xb0\xd0\xbd\xd0\xbe\xd0\xba\xd0\xbe\xd0\xb1\xd0\xb0\xd0\xbb\xd0\xb0\xd0\xbc\xd0\xb8\xd0\xbd\x2c\x20\xd1\x82\xd0\xb0\xd0\xba\x20\xd0\xba\xd0\xb0\xd0\xba\x20\xd0\xb8\xd0\xbc\xd0\xb5\xd0\xbd\xd0\xbd\xd0\xbe"
+ 'utf-8))))
+
(labels ((check-weak-list-unique (weak-list &optional reversep)
"Check that elements of WEAK-LIST are referenced only there."
(let ((len (length (weak-list-list weak-list))))
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
[COMMIT] Remove #'weak-box-ref-1 from the dumped Lisp, ensure a reasonable docstring
5 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1555271198 -3600
# Sun Apr 14 20:46:38 2019 +0100
# Node ID 0a871e6424f98ebba6b22ceea1531da1f85358a8
# Parent 900e287bde1f0288186a4db74f7c4138be468deb
Remove #'weak-box-ref-1 from the dumped Lisp, ensure a reasonable docstring
2019-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
* misc.el:
* misc.el (make-weak-box):
* misc.el (weak-box-ref):
* misc.el (:load-toplevel):
Remove #'weak-box-ref-1 from the dumped Lisp binary, using
(eval-when (:load-toplevel) ...) to ensure a reasonable docstring.
diff -r 900e287bde1f -r 0a871e6424f9 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Apr 14 15:00:53 2019 +0100
+++ b/lisp/ChangeLog Sun Apr 14 20:46:38 2019 +0100
＠＠ -1,3 +1,12 ＠＠
+2019-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * misc.el:
+ * misc.el (make-weak-box):
+ * misc.el (weak-box-ref):
+ * misc.el (:load-toplevel):
+ Remove #'weak-box-ref-1 from the dumped Lisp binary, using
+ (eval-when (:load-toplevel) ...) to ensure a reasonable docstring.
+
2019-03-28 Aidan Kehoe <kehoea(a)parhasard.net>
* x-init.el (pseudo-canonicalize-keysym):
diff -r 900e287bde1f -r 0a871e6424f9 lisp/misc.el
--- a/lisp/misc.el Sun Apr 14 15:00:53 2019 +0100
+++ b/lisp/misc.el Sun Apr 14 20:46:38 2019 +0100
＠＠ -94,6 +94,7 ＠＠
(progn
(defalias 'weak-box-ref-1
#'(lambda (weak-box)
+ (check-type weak-box weak-box)
(cdr (assq weak-box
(weak-list-list all-weak-boxes)))))
;; Use defvar so calls to #'make-weak-box when it is
＠＠ -110,7 +111,17 ＠＠
(defun weak-box-ref (weak-box)
"Return the contents of weak box WEAK-BOX.
If the contents have been GCed, return NIL."
- (check-argument-type 'weak-box-p weak-box)
(weak-box-ref-1 weak-box))
+(eval-when (:load-toplevel)
+ (defalias 'weak-box-ref
+ (make-byte-code
+ (compiled-function-arglist (symbol-function 'weak-box-ref-1))
+ (compiled-function-instructions (symbol-function 'weak-box-ref-1))
+ (compiled-function-constants (symbol-function 'weak-box-ref-1))
+ (compiled-function-stack-depth (symbol-function 'weak-box-ref-1))
+ ;; Use the docstring info of #'weak-box-ref itself.
+ (compiled-function-doc-string (symbol-function 'weak-box-ref))))
+ (unintern 'weak-box-ref-1))
+
;;; misc.el ends here
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
[COMMIT] Reduce char->byte conversion costs, #'forward-{char,line}, #'point-at-{eol-bol}
5 years, 8 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1555250453 -3600
# Sun Apr 14 15:00:53 2019 +0100
# Node ID 900e287bde1f0288186a4db74f7c4138be468deb
# Parent a975482ad82db38730ffaaf33e0db6092f7cf779
Reduce char->byte conversion costs, #'forward-{char,line}, #'point-at-{eol-bol}
src/ChangeLog addition:
2019-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
* cmds.c (Fforward_char):
Make this usually free in terms of calls to charbpos_to_bytebpos().
* cmds.c (Fforward_line):
Avoid needless char-byte conversion in this function.
* cmds.c (Fpoint_at_bol):
Ditto.
* cmds.c (Fpoint_at_eol):
Ditto.
* lisp.h:
Remove the declaration for find_before_next_newline(), no longer
used.
* search.c :
Remove find_before_next_newline(), only called by Fpoint_at_eol(),
which now includes the (very simple) implementation of f_b_n_n().
diff -r a975482ad82d -r 900e287bde1f src/ChangeLog
--- a/src/ChangeLog Sun Apr 14 13:23:03 2019 +0100
+++ b/src/ChangeLog Sun Apr 14 15:00:53 2019 +0100
＠＠ -1,3 +1,20 ＠＠
+2019-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cmds.c (Fforward_char):
+ Make this usually free in terms of calls to charbpos_to_bytebpos().
+ * cmds.c (Fforward_line):
+ Avoid needless char-byte conversion in this function.
+ * cmds.c (Fpoint_at_bol):
+ Ditto.
+ * cmds.c (Fpoint_at_eol):
+ Ditto.
+ * lisp.h:
+ Remove the declaration for find_before_next_newline(), no longer
+ used.
+ * search.c :
+ Remove find_before_next_newline(), only called by Fpoint_at_eol(),
+ which now includes the (very simple) implementation of f_b_n_n().
+
2019-04-14 Aidan Kehoe <kehoea(a)parhasard.net>
Get Stephen's last change compiling, fix a clear bug.
diff -r a975482ad82d -r 900e287bde1f src/cmds.c
--- a/src/cmds.c Sun Apr 14 13:23:03 2019 +0100
+++ b/src/cmds.c Sun Apr 14 15:00:53 2019 +0100
＠＠ -76,21 +76,48 ＠＠
proposed position, then set point. */
{
Charbpos new_point = BUF_PT (buf) + n;
+ Bytebpos bcursor;
if (new_point < BUF_BEGV (buf))
{
- BUF_SET_PT (buf, BUF_BEGV (buf));
+ BOTH_BUF_SET_PT (buf, BUF_BEGV (buf), BYTE_BUF_BEGV (buf));
Fsignal (Qbeginning_of_buffer, Qnil);
return Qnil;
}
if (new_point > BUF_ZV (buf))
{
- BUF_SET_PT (buf, BUF_ZV (buf));
+ BOTH_BUF_SET_PT (buf, BUF_ZV (buf), BYTE_BUF_ZV (buf));
Fsignal (Qend_of_buffer, Qnil);
return Qnil;
}
- BUF_SET_PT (buf, new_point);
+ bcursor = BYTE_BUF_PT (buf);
+
+ if (n >= 0)
+ {
+ while (n != 0 && n <= 16)
+ {
+ bcursor = next_bytebpos (buf, bcursor);
+ n--;
+ }
+ }
+ else
+ {
+ while (n != 0 && n >= -16)
+ {
+ bcursor = prev_bytebpos (buf, bcursor);
+ n++;
+ }
+ }
+
+ if (n == 0) /* We don't need to call charbpos_to_bytebpos(). */
+ {
+ BOTH_BUF_SET_PT (buf, new_point, bcursor);
+ }
+ else
+ {
+ BUF_SET_PT (buf, new_point);
+ }
}
return Qnil;
＠＠ -115,8 +142,7 ＠＠
(count, buffer))
{
struct buffer *buf = decode_buffer (buffer, 1);
- Charbpos pos2 = BUF_PT (buf);
- Charbpos pos;
+ Bytebpos pos;
EMACS_INT n, shortage, negp;
if (NILP (count))
＠＠ -128,14 +154,15 ＠＠
}
negp = n <= 0;
- pos = scan_buffer (buf, '\n', pos2, 0, n - negp, &shortage, 1);
+ pos = byte_scan_buffer (buf, '\n', BYTE_BUF_PT (buf), 0, n - negp,
+ &shortage, 1);
if (shortage > 0
&& (negp
- || (BUF_ZV (buf) > BUF_BEGV (buf)
- && pos != pos2
- && BUF_FETCH_CHAR (buf, pos - 1) != '\n')))
+ || (BYTE_BUF_ZV (buf) > BYTE_BUF_BEGV (buf)
+ && pos != BYTE_BUF_PT (buf)
+ && byte_beginning_of_line_p (buf, pos))))
shortage--;
- BUF_SET_PT (buf, pos);
+ BYTE_BUF_SET_PT (buf, pos);
return make_fixnum (negp ? - shortage : shortage);
}
＠＠ -148,23 +175,21 ＠＠
(count, buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
- REGISTER Charbpos orig, end;
+ EMACS_INT n, shortage, negp;
+ Bytebpos pos;
- buffer = wrap_buffer (b);
if (NILP (count))
- count = make_fixnum (0);
+ n = 0;
else
{
CHECK_FIXNUM (count);
- count = make_fixnum (XFIXNUM (count) - 1);
+ n = XFIXNUM (count) - 1;
}
- orig = BUF_PT (b);
- Fforward_line (count, buffer);
- end = BUF_PT (b);
- BUF_SET_PT (b, orig);
+ negp = n <= 0;
+ pos = byte_scan_buffer (b, '\n', BYTE_BUF_PT (b), 0, n - negp, &shortage, 1);
- return make_fixnum (end);
+ return make_integer (bytebpos_to_charbpos (b, pos));
}
DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /*
＠＠ -176,7 +201,8 ＠＠
(count, buffer))
{
struct buffer *buf = decode_buffer (buffer, 1);
- EMACS_INT n;
+ EMACS_INT n, shortage;
+ Bytebpos pos;
if (NILP (count))
n = 1;
＠＠ -186,8 +212,15 ＠＠
n = XFIXNUM (count);
}
- return make_fixnum (find_before_next_newline (buf, BUF_PT (buf), 0,
- n - (n <= 0)));
+ pos = byte_scan_buffer (buf, '\n', BYTE_BUF_PT (buf), 0, n - (n <= 0),
+ &shortage, 1);
+
+ if (shortage == 0)
+ {
+ pos = prev_bytebpos (buf, pos);
+ }
+
+ return make_integer (bytebpos_to_charbpos (buf, pos));
}
DEFUN ("delete-char", Fdelete_char, 0, 2, "*p\nP", /*
diff -r a975482ad82d -r 900e287bde1f src/lisp.h
--- a/src/lisp.h Sun Apr 14 13:23:03 2019 +0100
+++ b/src/lisp.h Sun Apr 14 15:00:53 2019 +0100
＠＠ -6017,8 +6017,6 ＠＠
Bytebpos byte_find_next_newline_no_quit (struct buffer *, Bytebpos, int);
Bytecount byte_find_next_ichar_in_string (Lisp_Object, Ichar, Bytecount,
EMACS_INT);
-Charbpos find_before_next_newline (struct buffer *, Charbpos, Charbpos,
- EMACS_INT);
struct re_pattern_buffer *compile_pattern (Lisp_Object pattern,
struct re_registers *regp,
Lisp_Object translate,
diff -r a975482ad82d -r 900e287bde1f src/search.c
--- a/src/search.c Sun Apr 14 13:23:03 2019 +0100
+++ b/src/search.c Sun Apr 14 15:00:53 2019 +0100
＠＠ -918,22 +918,6 ＠＠
}
return st;
}
-
-/* Like find_next_newline, but returns position before the newline,
- not after, and only search up to TO. This isn't just
- find_next_newline (...)-1, because you might hit TO. */
-Charbpos
-find_before_next_newline (struct buffer *buf, Charbpos from, Charbpos to,
- EMACS_INT count)
-{
- EMACS_INT shortage;
- Charbpos pos = scan_buffer (buf, '\n', from, to, count, &shortage, 1);
-
- if (shortage == 0)
- pos--;
-
- return pos;
-}
/* This function synched with FSF 21.1 */
static Lisp_Object
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
Work around Xlib caching of device metrics
5 years, 8 months
Stephen J. Turnbull
Stephen J. Turnbull
21.5 APPROVED
Sometimes I'm fine with the usual geometry of frames, sometimes I want
them vertically maximized (which the quartzwm doesn't provide an easy
way to do), so I have a Lisp function to do it. That function was
unreliable because #'device-system-metric was. This patch fixes it.
History and analysis:
Several months ago I got an external monitor, which when plugged in to
my notebook automatically changes the dimensions of the X screen from
1280x800 to something like 2560x1420. #'device-system-metric doesn't
recognize those changes. I believe that's because Xlib caches screen
metrics in the screen struct, and doesn't catch the change on the fly.
The information on the root window, which of course fills the screen,
*is* updated (I assume this costs a protocol request, but this
function is not used often -- not at all in core Lisp as far as I
could tell). The patch changes x_device_system_metrics to get the
geometry of the root window rather than using the ScreenWidth and
ScreenHeight macros. It does the trick in light testing.
It also changes x_set_frame_position and balloon_help_create to use
Fdevice_system_metric for the same reason (specifically, if the screen
shrinks and a small window is positioned against the right or bottom
edges, it could easily end up off-screen!)
I considered selecting ConfigureNotify and caching in XEmacs, but
decided against it. The rationale is in the source (see attached patch).
diff -r 2d6c322fbf80 src/ChangeLog
--- a/src/ChangeLog Thu Mar 28 19:10:32 2019 +0000
+++ b/src/ChangeLog Fri Apr 05 19:02:12 2019 +0900
＠＠ -1,3 +1,16 ＠＠
+2019-04-02 Stephen J. Turnbull <turnbull(a)sk.tsukuba.ac.jp>
+
+ * device-x.c (x_device_system_metrics):
+ Use geometry of root window to get pixel size of display, not the
+ Display* macros. The Xlib macros (and functions!) seem to cache
+ old values, which gives wrong results on displays that can change
+ size on the fly.
+
+ * frame-x.c (x_set_frame_position):
+ * balloon_help.c (balloon_help_create):
+ Use Fdevice_system_metric for width and height in case screen size
+ has changed. Change "frame_[wh]" to "screen_[wh]".
+
2019-03-23 Jerry James <james(a)xemacs.org>
* array.h (XD_DYNARR_DESC,XD_LISP_DYNARR_DESC): fix segfaults when
diff -r 2d6c322fbf80 src/balloon_help.c
--- a/src/balloon_help.c Thu Mar 28 19:10:32 2019 +0000
+++ b/src/balloon_help.c Fri Apr 05 19:02:12 2019 +0900
＠＠ -507,6 +507,8 ＠＠
Pixel fg, Pixel bg, Pixel shine, Pixel shadow,
XFontStruct* font)
{
+ Lisp_Object root_size;
+
if (b_dpy) balloon_help_destroy ();
b_dpy = dpy;
＠＠ -526,8 +528,11 ＠＠
b_timer = None;
b_delay = 500;
- b_screenWidth = DisplayWidth (b_dpy, DefaultScreen(b_dpy));
- b_screenHeight = DisplayHeight (b_dpy, DefaultScreen(b_dpy));
+ root_size = Fdevice_system_metric (get_device_from_display (dpy),
+ Qsize_device,
+ Qnil);
+ b_screenWidth = XFIXNUM (XCAR (root_size));
+ b_screenHeight = XFIXNUM (XCDR (root_size));
b_lastShape = SHAPE_CONE_FREE;
}
diff -r 2d6c322fbf80 src/device-x.c
--- a/src/device-x.c Thu Mar 28 19:10:32 2019 +0000
+++ b/src/device-x.c Fri Apr 05 19:02:12 2019 +0900
＠＠ -1755,12 +1755,29 ＠＠
switch (m)
{
+ /* In Xlib, both macros and functions checking configuration
+ seem to cache the results from the first call. So we check on
+ the root window instead. I considered selecting ConfigureNotify
+ on the root window, checking the size on that event, and caching
+ the result in struct x_device. However, ConfigureNotify doesn't
+ seem to be used that way for any other device metrics, so
+ responding to the event immediately doesn't seem necessary, and
+ it would involve complexity I don't understand. I guess this is
+ because Xlib does so much caching itself, so that using Xlib
+ calls is not very expensive for rarely changing metrics. */
case DM_size_device:
- return Fcons (make_fixnum (DisplayWidth (dpy, DefaultScreen (dpy))),
- make_fixnum (DisplayHeight (dpy, DefaultScreen (dpy))));
+ {
+ int x, y;
+ /* Nobody would be running X on a smaller screen, right? */
+ Dimension w = 1024, h = 768, b, d;
+ Window root = RootWindow(dpy, DefaultScreen(dpy));
+ /* If this fails, Xlib promises w and h are not updated. */
+ XGetGeometry(dpy, root, &root, &x, &y, &w, &h, &b, &d);
+ Fcons (make_fixnum (w), make_fixnum (h));
+ }
case DM_size_device_mm:
- return Fcons (make_fixnum (DisplayWidthMM (dpy, DefaultScreen (dpy))),
- make_fixnum (DisplayHeightMM (dpy, DefaultScreen (dpy))));
+ return Fcons (make_fixnum (XDisplayWidthMM (dpy, DefaultScreen (dpy))),
+ make_fixnum (XDisplayHeightMM (dpy, DefaultScreen (dpy))));
case DM_num_bit_planes:
return make_fixnum (DisplayPlanes (dpy, DefaultScreen (dpy)));
case DM_num_color_cells:
diff -r 2d6c322fbf80 src/frame-x.c
--- a/src/frame-x.c Thu Mar 28 19:10:32 2019 +0000
+++ b/src/frame-x.c Fri Apr 05 19:02:12 2019 +0900
＠＠ -2228,8 +2228,11 ＠＠
{
Widget w = FRAME_X_SHELL_WIDGET (f);
Display *dpy = XtDisplay (w);
- Dimension frame_w = DisplayWidth (dpy, DefaultScreen (dpy));
- Dimension frame_h = DisplayHeight (dpy, DefaultScreen (dpy));
+ Lisp_Object root_size = Fdevice_system_metric (FRAME_DEVICE (f),
+ Qsize_device,
+ Qnil);
+ Dimension screen_w = XFIXNUM (XCAR (root_size));
+ Dimension screen_h = XFIXNUM (XCDR (root_size));
Dimension shell_w, shell_h, shell_bord;
int win_gravity;
Arg al[3];
＠＠ -2245,9 +2248,9 ＠＠
yoff >= 0 ? NorthEastGravity :
SouthEastGravity;
if (xoff < 0)
- xoff += frame_w - shell_w - 2*shell_bord;
+ xoff += screen_w - shell_w - 2*shell_bord;
if (yoff < 0)
- yoff += frame_h - shell_h - 2*shell_bord;
+ yoff += screen_h - shell_h - 2*shell_bord;
/* Update the hints so that, if this window is currently iconified, it will
come back at the right place. We can't look at s->visible to determine
- 2 participants
- 1 comments