commit 804a0e82f2672db7cabddd99958cc97d5679beeb (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Thu Aug 13 10:29:44 2020 +0200 Don't output emacsclient warning if both -a and --quiet * lib-src/emacsclient.c (set_local_socket): Don't output the warning if both -a and --quiet are specified (bug#16117). Inspired by a patch from Scott Turner . diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 380be95222..871fa7a8d3 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1504,11 +1504,17 @@ set_local_socket (char const *server_name) "%s: (Be careful: XDG_RUNTIME_DIR is security-related.)\n"), progname, sockdirname, progname); } - message (true, - ("%s: can't find socket; have you started the server?\n" - "%s: To start the server in Emacs," - " type \"M-x server-start\".\n"), - progname, progname); + + /* If there's an alternate editor and the user has requested + --quiet, don't output the warning. */ + if (!quiet || !alternate_editor) + { + message (true, + ("%s: can't find socket; have you started the server?\n" + "%s: To start the server in Emacs," + " type \"M-x server-start\".\n"), + progname, progname); + } } else message (true, "%s: can't stat %s: %s\n", commit 991e145450ec8b02865597bc80fd797e39e81f07 Author: Emilio Lopes Date: Thu Aug 13 10:01:00 2020 +0200 Notify the user if we errors when querying for registered git files * lisp/vc/vc-git.el (vc-git-registered): Notify the user when something fails here (bug#18481). diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index e0cf9e7959..78a2fa0879 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -243,7 +243,7 @@ toggle display of the entire list." ;; path specs. ;; See also: http://marc.info/?l=git&m=125787684318129&w=2 (name (file-relative-name file dir)) - (str (ignore-errors + (str (with-demoted-errors "Error: %S" (cd dir) (vc-git--out-ok "ls-files" "-c" "-z" "--" name) ;; If result is empty, use ls-tree to check for deleted commit 97896e68f9a8749381d023c75db5df352455f76a Author: Paul Eggert Date: Wed Aug 12 18:38:52 2020 -0700 mml-secure-en-decrypt-sign-2 is unstable * test/lisp/gnus/mml-sec-tests.el (mml-secure-en-decrypt-sign-2): Mark as unstable (Bug#42720). diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 272918688d..07da4bffa5 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -681,6 +681,7 @@ In this test, just multiple encryption and signing keys may be available." (ert-deftest mml-secure-en-decrypt-sign-2 () "Sign and encrypt message; then decrypt and test for expected result. In this test, lists of encryption and signing keys are customized." + :tags '(:unstable) (skip-unless (test-conf)) (mml-secure-test-key-fixture (lambda () commit 63b7697a677260c21730440d797763b442622d95 Author: Stefan Kangas Date: Thu Aug 13 01:39:53 2020 +0200 Remove Emacs 22 compat code from dns.el * lisp/net/dns.el (dns-servers-up-to-date-p, dns-set-servers): Remove check for function that is always there. diff --git a/lisp/net/dns.el b/lisp/net/dns.el index c3c294395c..c368cd773c 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -316,8 +316,6 @@ If TCP-P, the first two bytes of the packet will be the length field." "Return false if we need to recheck the list of DNS servers." (and dns-servers (or (eq dns-servers-valid-for-interfaces t) - ;; `network-interface-list' was introduced in Emacs 22.1. - (not (fboundp 'network-interface-list)) (equal dns-servers-valid-for-interfaces (network-interface-list))))) @@ -339,8 +337,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (when (re-search-forward "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t) (setq dns-servers (list (match-string 1))))))) - (when (fboundp 'network-interface-list) - (setq dns-servers-valid-for-interfaces (network-interface-list)))) + (setq dns-servers-valid-for-interfaces (network-interface-list))) (defun dns-read-txt (string) (if (> (length string) 1) commit 434ebb51edd1d36737f4b41c7255a333acde9d31 Author: Stefan Kangas Date: Thu Aug 13 01:29:47 2020 +0200 Declare semantic XEmacs compat code obsolete * lisp/cedet/semantic/grammar.el (semantic-grammar-setup-menu-xemacs): Declare obsolete. diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 1ed18339a7..6cd4832165 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1251,6 +1251,7 @@ common grammar menu." "Setup an XEmacs grammar menu in variable SYMBOL. MODE-MENU is an optional specific menu whose items are appended to the common grammar menu." + (declare (obsolete nil "28.1")) (let ((items (make-symbol "items")) (path (make-symbol "path"))) `(progn commit 2a0a47ce52b57ba37b75fb9664821154cb373ff0 Author: Stefan Kangas Date: Thu Aug 13 01:23:46 2020 +0200 Remove XEmacs compat code from allout-widgets.el * lisp/allout-widgets.el (allout-widgets-item-image-properties-xemacs) (allout-item-widget, allout-fetch-icon-image) (allout-widgets-copy-list): Remove XEmacs compat code. diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 159b2aa35b..03fc3e2f0e 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -207,6 +207,7 @@ See `allout-widgets-mode' for allout widgets mode features." :version "24.1" :type 'plist :group 'allout-widgets) +(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1") ;;;_ . Developer ;;;_ = allout-widgets-run-unit-tests-on-load (defcustom allout-widgets-run-unit-tests-on-load nil @@ -1509,8 +1510,7 @@ recursive operation." ;; the actual location of the item text: :location 'allout-item-location - :button-keymap allout-item-icon-keymap ; XEmacs - :keymap allout-item-icon-keymap ; Emacs + :keymap allout-item-icon-keymap ;; Element regions: :guides-span nil @@ -2328,15 +2328,13 @@ We use a caching strategy, so the caller doesn't need to do so." (allout-widgets-copy-list (cadr got)) (while (and types (not got)) (setq got - (allout-find-image + (find-image (list (append (list :type (car types) :file (concat use-dir (symbol-name name) "." (symbol-name (car types)))) - (if (featurep 'xemacs) - allout-widgets-item-image-properties-xemacs - allout-widgets-item-image-properties-emacs) + allout-widgets-item-image-properties-emacs )))) (setq types (cdr types))) (if got @@ -2357,11 +2355,7 @@ We use a caching strategy, so the caller doesn't need to do so." 'frame-property) (t nil))) ;;;_ > allout-find-image (specs) -(defalias 'allout-find-image - (if (fboundp 'find-image) - 'find-image - nil) ; aka, not-yet-implemented for xemacs. -) +(define-obsolete-function-alias 'allout-find-image #'find-image "28.1") ;;;_ > allout-widgets-copy-list (list) (defun allout-widgets-copy-list (list) ;; duplicated from cl.el 'copy-list' as of 2008-08-17 commit fd6058b8fb07329bdd7d36cd05f4be1c5c691f9f Author: Stefan Monnier Date: Wed Aug 12 14:46:13 2020 -0400 * lisp/net/mailcap.el (mailcap-mime-data): Remove long-forgotten `ee` It referred apparently to the "Electric Eyes" image viewer: https://archive.org/details/tucows_31588_Electric_Eyes diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 86f9d2bf07..f01a5deb7e 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -269,11 +269,6 @@ is consulted." (viewer . "display %s") (type . "image/*") (test . (eq window-system 'x)) - ("needsx11")) - (".*" - (viewer . "ee %s") - (type . "image/*") - (test . (eq window-system 'x)) ("needsx11"))) ("text" ("plain" commit 7e3fd65bb92eca64cbe310f0fe6f018dfedf8a44 Author: Paul Eggert Date: Wed Aug 12 11:40:12 2020 -0700 Stop using Gnulib inttypes module It wasn’t needed for MinGW after all, no other platform seems to need it, and it slows down ‘configure’. * admin/merge-gnulib (GNULIB_MODULES): Remove inttypes. * m4/gnulib-comp.m4: Regenerate. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 98f7941bd8..3f32536a62 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -36,7 +36,7 @@ GNULIB_MODULES=' fchmodat fcntl fcntl-h fdopendir filemode filename filevercmp flexmember fpieee fstatat fsusage fsync futimens getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog - ieee754-h ignore-value intprops inttypes largefile libgmp lstat + ieee754-h ignore-value intprops largefile libgmp lstat manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index e7e9fbdc31..92d0621c61 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -116,7 +116,6 @@ # ieee754-h \ # ignore-value \ # intprops \ -# inttypes \ # largefile \ # libgmp \ # lstat \ diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 1f8a87218e..5bfa1473ed 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -113,7 +113,6 @@ AC_DEFUN([gl_EARLY], # Code from module ignore-value: # Code from module include_next: # Code from module intprops: - # Code from module inttypes: # Code from module inttypes-incomplete: # Code from module largefile: AC_REQUIRE([AC_SYS_LARGEFILE]) @@ -343,7 +342,6 @@ AC_DEFUN([gl_INIT], fi gl_SYS_TIME_MODULE_INDICATOR([gettimeofday]) gl_IEEE754_H - gl_INTTYPES_H gl_INTTYPES_INCOMPLETE AC_REQUIRE([gl_LARGEFILE]) gl___INLINE commit e697ca152570d59f9b591fc2003292c30d4be050 Author: Paul Eggert Date: Wed Aug 12 11:37:52 2020 -0700 Update from Gnulib This incorporates: 2020-08-12 stdint: port intptr_t to more-recent MinGW 2020-08-11 Use __restrict also on clang 2020-08-11 Use flexible array syntax also on clang 2020-08-11 fcntl: On native Windows, use _setmode, not setmode * lib/binary-io.h, lib/cdefs.h, lib/fcntl.c, lib/regex.h: * lib/stdint.in.h: Copy from Gnulib. diff --git a/lib/binary-io.h b/lib/binary-io.h index 477b4bf4dd..d17af7c380 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -56,7 +56,7 @@ __gl_setmode (int fd _GL_UNUSED, int mode _GL_UNUSED) /* Set FD's mode to MODE, which should be either O_TEXT or O_BINARY. Return the old mode if successful, -1 (setting errno) on failure. Ordinarily this function would be called 'setmode', since that is - its name on MS-Windows, but it is called 'set_binary_mode' here + its old name on MS-Windows, but it is called 'set_binary_mode' here to avoid colliding with a BSD function of another name. */ #if defined __DJGPP__ || defined __EMX__ diff --git a/lib/cdefs.h b/lib/cdefs.h index beedd891fb..4f89f4e4bf 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -167,8 +167,8 @@ #if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L && !defined __HP_cc # define __flexarr [] # define __glibc_c99_flexarr_available 1 -#elif __GNUC_PREREQ (2,97) -/* GCC 2.97 supports C99 flexible array members as an extension, +#elif __GNUC_PREREQ (2,97) || defined __clang__ +/* GCC 2.97 and clang support C99 flexible array members as an extension, even when in C89 mode or compiling C++ (any version). */ # define __flexarr [] # define __glibc_c99_flexarr_available 1 @@ -399,8 +399,10 @@ # define __extension__ /* Ignore */ #endif -/* __restrict is known in EGCS 1.2 and above. */ -#if !__GNUC_PREREQ (2,92) +/* __restrict is known in EGCS 1.2 and above, and in clang. + It works also in C++ mode (outside of arrays), but only when spelled + as '__restrict', not 'restrict'. */ +#if !(__GNUC_PREREQ (2,92) || __clang_major__ >= 3) # if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L # define __restrict restrict # else @@ -410,8 +412,9 @@ /* ISO C99 also allows to declare arrays as non-overlapping. The syntax is array_name[restrict] - GCC 3.1 supports this. */ -#if __GNUC_PREREQ (3,1) && !defined __GNUG__ + GCC 3.1 and clang support this. + This syntax is not usable in C++ mode. */ +#if (__GNUC_PREREQ (3,1) || __clang_major__ >= 3) && !defined __cplusplus # define __restrict_arr __restrict #else # ifdef __GNUC__ diff --git a/lib/fcntl.c b/lib/fcntl.c index 6b9927ec4e..8cd1531527 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -70,14 +70,14 @@ dupfd (int oldfd, int newfd, int flags) return -1; } if (old_handle == INVALID_HANDLE_VALUE - || (mode = setmode (oldfd, O_BINARY)) == -1) + || (mode = _setmode (oldfd, O_BINARY)) == -1) { /* oldfd is not open, or is an unassigned standard file descriptor. */ errno = EBADF; return -1; } - setmode (oldfd, mode); + _setmode (oldfd, mode); flags |= mode; for (;;) diff --git a/lib/regex.h b/lib/regex.h index 610f139eb3..306521a3e8 100644 --- a/lib/regex.h +++ b/lib/regex.h @@ -612,7 +612,9 @@ extern int re_exec (const char *); 'configure' might #define 'restrict' to those words, so pick a different name. */ #ifndef _Restrict_ -# if defined __restrict || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) +# if defined __restrict \ + || 2 < __GNUC__ + (95 <= __GNUC_MINOR__) \ + || __clang_major__ >= 3 # define _Restrict_ __restrict # elif 199901L <= __STDC_VERSION__ || defined restrict # define _Restrict_ restrict @@ -620,13 +622,18 @@ extern int re_exec (const char *); # define _Restrict_ # endif #endif -/* For [restrict], use glibc's __restrict_arr if available. - Otherwise, GCC 3.1 (not in C++ mode) and C99 support [restrict]. */ +/* For the ISO C99 syntax + array_name[restrict] + use glibc's __restrict_arr if available. + Otherwise, GCC 3.1 and clang support this syntax (but not in C++ mode). + Other ISO C99 compilers support it as well. */ #ifndef _Restrict_arr_ # ifdef __restrict_arr # define _Restrict_arr_ __restrict_arr -# elif ((199901L <= __STDC_VERSION__ || 3 < __GNUC__ + (1 <= __GNUC_MINOR__)) \ - && !defined __GNUG__) +# elif ((199901L <= __STDC_VERSION__ \ + || 3 < __GNUC__ + (1 <= __GNUC_MINOR__) \ + || __clang_major__ >= 3) \ + && !defined __cplusplus) # define _Restrict_arr_ _Restrict_ # else # define _Restrict_arr_ diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 994c0c777c..63fa1aa628 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -302,12 +302,11 @@ typedef gl_uint_fast32_t gl_uint_fast16_t; /* kLIBC's defines _INTPTR_T_DECLARED and needs its own definitions of intptr_t and uintptr_t (which use int and unsigned) to avoid clashes with declarations of system functions like sbrk. - Similarly, mingw 5.22 defines _INTPTR_T_DEFINED and - _UINTPTR_T_DEFINED and needs its own definitions of intptr_t and + Similarly, MinGW WSL-5.4.1 needs its own intptr_t and uintptr_t to avoid conflicting declarations of system functions like _findclose in . */ # if !((defined __KLIBC__ && defined _INTPTR_T_DECLARED) \ - || (defined __MINGW32__ && defined _INTPTR_T_DEFINED && defined _UINTPTR_T_DEFINED)) + || defined __MINGW32__) # undef intptr_t # undef uintptr_t # ifdef _WIN64 commit 9102ecc63b094ffebae2215adc4a840a8b66f6d8 Author: Lars Ingebrigtsen Date: Wed Aug 12 19:54:09 2020 +0200 Remove some compat code from mm-util.el * lisp/gnus/mm-util.el (mm-charset-to-coding-system): Remove the non-mule case, because it's always false. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 83f385065c..282465722d 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -131,10 +131,6 @@ is not available." (cond ((null charset) charset) - ;; Running in a non-MULE environment. - ((or (null (mm-get-coding-system-list)) - (not (fboundp 'coding-system-get))) - charset) ;; Check override list quite early. Should only used for decoding, not for ;; encoding! ((and allow-override commit 36466ed6663d65c5536b6fd5bec5fc3f5c2a18f9 Author: Lars Ingebrigtsen Date: Wed Aug 12 19:52:11 2020 +0200 Simplify the computation of mm-mime-mule-charset-alist * lisp/gnus/mm-util.el (mm-mime-mule-charset-alist): For compatibility with XEmacs, mm-mime-mule-charset-alist was first set to a list of hard-coded entries, and then overwritten on Emacs from `coding-system-list'. Remove the hard-coded values and simplify the code. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 7629d5cb15..83f385065c 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -295,77 +295,16 @@ superset of iso-8859-1." (defvar mm-universal-coding-system mm-auto-save-coding-system "The universal coding system.") -;; Fixme: some of the cars here aren't valid MIME charsets. That -;; should only matter with XEmacs, though. (defvar mm-mime-mule-charset-alist - '((us-ascii ascii) - (iso-8859-1 latin-iso8859-1) - (iso-8859-2 latin-iso8859-2) - (iso-8859-3 latin-iso8859-3) - (iso-8859-4 latin-iso8859-4) - (iso-8859-5 cyrillic-iso8859-5) - ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. - ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default - ;; charset is koi8-r, not iso-8859-5. - (koi8-r cyrillic-iso8859-5 gnus-koi8-r) - (iso-8859-6 arabic-iso8859-6) - (iso-8859-7 greek-iso8859-7) - (iso-8859-8 hebrew-iso8859-8) - (iso-8859-9 latin-iso8859-9) - (iso-8859-14 latin-iso8859-14) - (iso-8859-15 latin-iso8859-15) - (viscii vietnamese-viscii-lower) - (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) - (euc-kr korean-ksc5601) - (gb2312 chinese-gb2312) - (gbk chinese-gbk) - (gb18030 gb18030-2-byte - gb18030-4-byte-bmp gb18030-4-byte-smp - gb18030-4-byte-ext-1 gb18030-4-byte-ext-2) - (big5 chinese-big5-1 chinese-big5-2) - (tibetan tibetan) - (thai-tis620 thai-tis620) - (windows-1251 cyrillic-iso8859-5) - (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) - (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) - (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2) - (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2 - cyrillic-iso8859-5 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2 - chinese-cns11643-3 chinese-cns11643-4 - chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7) - (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 - japanese-jisx0213-1 japanese-jisx0213-2) - (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - (utf-8)) - "Alist of MIME-charset/MULE-charsets.") - -;; Correct by construction, but should be unnecessary for Emacs: -(when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) + (let (mime mule alist) + (dolist (cs (sort-coding-systems (coding-system-list 'base-only))) + (setq mime (coding-system-get cs 'mime-charset)) (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) + (not (eq t (setq mule (coding-system-get cs 'safe-charsets)))) (not (assq mime alist))) (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist)))) + (nreverse alist)) + "Alist of MIME-charset/MULE-charsets.") (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. commit b8062be48873189eeca707363ede84d0e7c45198 Author: Lars Ingebrigtsen Date: Wed Aug 12 19:41:24 2020 +0200 Remove some compat code from eudc-bob.el * lisp/net/eudc-bob.el (eudc-bob-save-object) (eudc-bob-pipe-object-to-external-program): Remove checks for functions that are always defined in Emacs. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index b248c88d49..56ea033a96 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -214,8 +214,7 @@ display a button." (let ((data (eudc-bob-get-overlay-prop 'object-data)) (buffer (generate-new-buffer "*eudc-tmp*"))) (save-excursion - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system 'binary)) + (set-buffer-file-coding-system 'binary) (set-buffer buffer) (set-buffer-multibyte nil) (insert data) @@ -231,8 +230,7 @@ display a button." viewer) (condition-case nil (save-excursion - (if (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system 'binary)) + (set-buffer-file-coding-system 'binary) (set-buffer buffer) (insert data) (setq program (completing-read "Viewer: " eudc-external-viewers)) commit b02bd6d0bb752d518ade9c1e78d02a7f5ed942bd Author: Lars Ingebrigtsen Date: Wed Aug 12 19:38:09 2020 +0200 Remove some compat code from url-handlers.el * lisp/url/url-handlers.el (url-insert-buffer-contents): Remove check for function that's always defined in Emacs. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 331152808f..1c3607bb66 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -339,8 +339,7 @@ if it had been inserted from a file named URL." (decode-coding-inserted-region (point-min) (point) url visit beg end replace)) (let ((inserted (car size-and-charset))) - (list url (or (and (fboundp 'after-insert-file-set-coding) - (after-insert-file-set-coding inserted visit)) + (list url (or (after-insert-file-set-coding inserted visit) inserted)))))) ;;;###autoload commit c0c24267b378e33c5c78dd347e2bb912cb81ce42 Author: Lars Ingebrigtsen Date: Wed Aug 12 19:33:50 2020 +0200 Remove some compat code from gnus.el * lisp/gnus/gnus.el: Remove a check for a function that is always defined. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 68e2ce772c..cecf4d4fb4 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1029,8 +1029,7 @@ Check the NNTPSERVER environment variable and the ;; `M-x customize-variable RET gnus-select-method RET' should work without ;; starting or even loading Gnus. -;;;###autoload(when (fboundp 'custom-autoload) -;;;###autoload (custom-autoload 'gnus-select-method "gnus")) +;;;###autoload(custom-autoload 'gnus-select-method "gnus") (defcustom gnus-select-method (list 'nntp (or (gnus-getenv-nntpserver) commit 2b69a4df78fcca44387368583e170db860f0013b Author: Amin Bandali Date: Wed Aug 12 13:33:36 2020 -0400 Add support for italic text in ERC * lisp/erc/erc-goodies.el (erc-italic-face): New face for italic text. (erc-controls-interpret), (erc-controls-highlight): Add `italicp'. (erc-controls-remove-regexp), (erc-controls-highlight-regexp): Handle C-] for italic. (erc-controls-propertize): Add `italicp' argument and use it to conditionally propertize text with the new `erc-italic-face'. * etc/NEWS: Announce italic text support. diff --git a/etc/NEWS b/etc/NEWS index b25e43bb9b..2be9743a45 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -717,6 +717,10 @@ https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. *** The /ignore command will now ask for a timeout to stop ignoring the user. Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m". +--- +*** ERC now recognizes C-] for italic text. +Italic text is displayed in the new 'erc-italic-face'. + ** Battery --- diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 94d5de280c..ff7a77f126 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -232,6 +232,10 @@ The value `erc-interpret-controls-p' must also be t for this to work." "ERC bold face." :group 'erc-faces) +(defface erc-italic-face '((t :slant italic)) + "ERC italic face." + :group 'erc-faces) + (defface erc-inverse-face '((t :foreground "White" :background "Black")) "ERC inverse face." @@ -383,6 +387,7 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (erc-controls-strip s)) (erc-interpret-controls-p (let ((boldp nil) + (italicp nil) (inversep nil) (underlinep nil) (fg nil) @@ -401,6 +406,8 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (setq bg bg-color)) ((string= control "\C-b") (setq boldp (not boldp))) + ((string= control "\C-]") + (setq italicp (not italicp))) ((string= control "\C-v") (setq inversep (not inversep))) ((string= control "\C-_") @@ -413,13 +420,14 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." (ding))) ((string= control "\C-o") (setq boldp nil + italicp nil inversep nil underlinep nil fg nil bg nil)) (t nil)) (erc-controls-propertize - start end boldp inversep underlinep fg bg s))) + start end boldp italicp inversep underlinep fg bg s))) s)) (t s))))) @@ -432,13 +440,13 @@ See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options." s))) (defvar erc-controls-remove-regexp - "\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" + "\C-b\\|\C-]\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?" "Regular expression which matches control characters to remove.") (defvar erc-controls-highlight-regexp - (concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" + (concat "\\(\C-b\\|\C-]\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|" "\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)" - "\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)") + "\\([^\C-b\C-]\C-v\C-_\C-c\C-g\C-o\n]*\\)") "Regular expression which matches control chars and the text to highlight.") (defun erc-controls-highlight () @@ -451,6 +459,7 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (replace-match ""))) (erc-interpret-controls-p (let ((boldp nil) + (italicp nil) (inversep nil) (underlinep nil) (fg nil) @@ -467,6 +476,8 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (setq bg bg-color)) ((string= control "\C-b") (setq boldp (not boldp))) + ((string= control "\C-]") + (setq italicp (not italicp))) ((string= control "\C-v") (setq inversep (not inversep))) ((string= control "\C-_") @@ -479,16 +490,17 @@ Also see `erc-interpret-controls-p' and `erc-interpret-mirc-color'." (ding))) ((string= control "\C-o") (setq boldp nil + italicp nil inversep nil underlinep nil fg nil bg nil)) (t nil)) (erc-controls-propertize start end - boldp inversep underlinep fg bg))))) + boldp italicp inversep underlinep fg bg))))) (t nil))) -(defun erc-controls-propertize (from to boldp inversep underlinep fg bg +(defun erc-controls-propertize (from to boldp italicp inversep underlinep fg bg &optional str) "Prepend properties from IRC control characters between FROM and TO. If optional argument STR is provided, apply to STR, otherwise prepend properties @@ -500,6 +512,9 @@ to a region in the current buffer." (append (if boldp '(erc-bold-face) nil) + (if italicp + '(erc-italic-face) + nil) (if inversep '(erc-inverse-face) nil) commit 56a44a882c651dae40bd8de1dc81101b4e87ab54 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:56:47 2020 +0200 Remove some compat code from viper-cmd.el * lisp/emulation/viper-cmd.el (viper-register-to-point): frame-configuration-p is always available in Emacs now. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 4c3a9b319b..77f1b29104 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -4695,8 +4695,7 @@ Please, specify your level now: ")) (interactive "cViper register to point: ") (let ((val (get-register char))) (cond - ((and (fboundp 'frame-configuration-p) - (frame-configuration-p val)) + ((frame-configuration-p val) (set-frame-configuration val)) ((window-configuration-p val) (set-window-configuration val)) commit 9a929de29bcc6ffba9f4f3b07e91587dae5ce61f Author: Lars Ingebrigtsen Date: Wed Aug 12 18:52:53 2020 +0200 Remove some compat code from viper*.el * lisp/emulation/viper.el (viper-go-away, viper-set-hooks) (viper-non-hook-settings, viper-mode): * lisp/emulation/viper-cmd.el (viper-normalize-minor-mode-map-alist) (viper-harness-minor-mode): Remove a bunch of checks to do (or not do) things based on whether add-to-ordered-list is fbound and emulation-mode-map-alists is bound, because in Emacs now, these are always true. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index ca7fcaf2d9..4c3a9b319b 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -466,24 +466,7 @@ (assoc major-mode viper-emacs-state-modifier-alist))) (cdr (assoc major-mode viper-emacs-state-modifier-alist)) - viper-empty-keymap)) - )) - - ;; This var is not local in Emacs, so we make it local. It must be local - ;; because although the stack of minor modes can be the same for all buffers, - ;; the associated *keymaps* can be different. In Viper, - ;; viper-vi-local-user-map, viper-insert-local-user-map, and others can have - ;; different keymaps for different buffers. Also, the keymaps associated - ;; with viper-vi/insert-state-modifier-minor-mode can be different. - ;; ***This is needed only in case emulation-mode-map-alists is not defined. - ;; In emacs with emulation-mode-map-alists, nothing needs to be done - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (set (make-local-variable 'minor-mode-map-alist) - (viper-append-filter-alist - (append viper--intercept-key-maps viper--key-maps) - minor-mode-map-alist))) - ) + viper-empty-keymap))))) @@ -893,16 +876,7 @@ LOAD-FILE is the name of the file where the specific minor mode is defined. Suffixes such as .el or .elc should be stripped." (interactive "sEnter name of the load file: ") - - (eval-after-load load-file '(viper-normalize-minor-mode-map-alist)) - - ;; Change the default for minor-mode-map-alist each time a harnessed minor - ;; mode adds its own keymap to the a-list. - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (eval-after-load - load-file '(setq-default minor-mode-map-alist minor-mode-map-alist))) - ) + (eval-after-load load-file '(viper-normalize-minor-mode-map-alist))) (defun viper-ESC (arg) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 8e7a34fc69..59ca6298eb 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -695,9 +695,6 @@ It also can't undo some Viper settings." 'mark-even-if-inactive viper-saved-non-viper-variables)) ;; Ideally, we would like to be able to de-localize local variables - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (viper-delocalize-var 'minor-mode-map-alist)) (viper-delocalize-var 'require-final-newline) ;; deactivate all advices done by Viper. @@ -705,11 +702,9 @@ It also can't undo some Viper settings." (setq viper-mode nil) - (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq emulation-mode-map-alists - (delq 'viper--intercept-key-maps - (delq 'viper--key-maps emulation-mode-map-alists)) - )) + (setq emulation-mode-map-alists + (delq 'viper--intercept-key-maps + (delq 'viper--key-maps emulation-mode-map-alists))) (viper-delocalize-var 'viper-vi-minibuffer-minor-mode) (viper-delocalize-var 'viper-insert-minibuffer-minor-mode) @@ -943,13 +938,11 @@ Two differences: (setq viper-vi-state-cursor-color color-name))) - (when (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - ;; needs to be as early as possible - (add-to-ordered-list - 'emulation-mode-map-alists 'viper--intercept-key-maps 100) - ;; needs to be after cua-mode - (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500) - ) + ;; needs to be as early as possible + (add-to-ordered-list + 'emulation-mode-map-alists 'viper--intercept-key-maps 100) + ;; needs to be after cua-mode + (add-to-ordered-list 'emulation-mode-map-alists 'viper--key-maps 500) ;; Emacs shell, ange-ftp, and comint-based modes (add-hook 'comint-mode-hook #'viper-comint-mode-hook) ; comint @@ -1062,10 +1055,7 @@ This may be needed if the previous `:map' command terminated abnormally." (viper--advice-add 'add-minor-mode :after (lambda (&rest _) "Run viper-normalize-minor-mode-map-alist after adding a minor mode." - (viper-normalize-minor-mode-map-alist) - (unless - (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)))) + (viper-normalize-minor-mode-map-alist))) ;; catch frame switching event (if (viper-window-display-p) @@ -1253,12 +1243,7 @@ These two lines must come in the order given.")) ;; Without setting the default, new buffers that come up in emacs mode have ;; minor-mode-map-alist = nil, unless we call viper-change-state-* (when (eq viper-current-state 'emacs-state) - (viper-change-state-to-emacs) - (unless - (and (fboundp 'add-to-ordered-list) - (boundp 'emulation-mode-map-alists)) - (setq-default minor-mode-map-alist minor-mode-map-alist)) - ) + (viper-change-state-to-emacs)) (if (this-major-mode-requires-vi-state major-mode) (viper-mode)) commit 1dfb170476602aa03eca2f637803f929f97b1549 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:46:27 2020 +0200 Mark some unused defaliases in semantic/fw.el obsolete * lisp/cedet/semantic/fw.el (semantic-run-mode-hooks) (semantic-subst-char-in-string): Make two unused defaliases obsolete. diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 7a1273d653..e347c99f19 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -68,13 +68,11 @@ ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to ;; run major mode hooks. -(defalias 'semantic-run-mode-hooks - (if (fboundp 'run-mode-hooks) - 'run-mode-hooks - 'run-hooks)) +(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1") - ;; Fancy compat usage now handled in cedet-compat -(defalias 'semantic-subst-char-in-string 'subst-char-in-string) +;; Fancy compat usage now handled in cedet-compat +(define-obsolete-function-alias 'semantic-subst-char-in-string + 'subst-char-in-string "28.1") (defun semantic-delete-overlay-maybe (overlay) "Delete OVERLAY if it is a semantic token overlay." commit e97d3e1a268c33ed6da420fa1d3a18268a1f6b91 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:43:06 2020 +0200 Remove some compat code from epa.el * lisp/epa.el (epa--derived-mode-p, epa-import-keys): Make defalias obsolete, and adjust a comment. diff --git a/lisp/epa.el b/lisp/epa.el index 3c7dd8309a..a2c5fb4673 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -1105,16 +1105,7 @@ If no one is selected, default secret key is used. " 'start-open t 'end-open t))))) -(defalias 'epa--derived-mode-p - (if (fboundp 'derived-mode-p) - #'derived-mode-p - (lambda (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards." - (let ((parent major-mode)) - (while (and (not (memq parent modes)) - (setq parent (get parent 'derived-mode-parent)))) - parent)))) +(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1") ;;;###autoload (defun epa-encrypt-region (start end recipients sign signers) @@ -1227,7 +1218,7 @@ If no one is selected, symmetric encryption will be performed. ") (if (epg-context-result-for context 'import) (epa-display-info (epg-import-result-to-string (epg-context-result-for context 'import)))) - ;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p? + ;; FIXME: Why not use the derived-mode-p? (if (eq major-mode 'epa-key-list-mode) (apply #'epa--list-keys epa-list-keys-arguments)))) commit af6ea5578abf01d97abd86735bbddd08251ec11e Author: Lars Ingebrigtsen Date: Wed Aug 12 18:39:17 2020 +0200 Remove some compat code from bubbles.el * lisp/play/bubbles.el (bubbles--remove-overlays): Make into an obsolete alias. (bubbles--initialize, bubbles--show-images): Adjust callers. diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index e598257379..903c068606 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -976,16 +976,14 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (* image-vert-size (bubbles--grid-height))) 2))))) -(defun bubbles--remove-overlays () - "Remove all overlays." - (if (fboundp 'remove-overlays) - (remove-overlays))) +(define-obsolete-function-alias 'bubbles--remove-overlays + 'remove-overlays "28.1") (defun bubbles--initialize () "Initialize Bubbles game." (bubbles--initialize-faces) (bubbles--initialize-images) - (bubbles--remove-overlays) + (remove-overlays) (switch-to-buffer (get-buffer-create "*bubbles*")) (bubbles--compute-offsets) @@ -1409,7 +1407,7 @@ Return t if new char is non-empty." (defun bubbles--show-images () "Update images in the bubbles buffer." - (bubbles--remove-overlays) + (remove-overlays) (if (and (display-images-p) bubbles--images-ok (not (eq bubbles-graphics-theme 'ascii))) commit 74909e1ec2ebef3d0a6911bb0b873ce165456813 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:37:18 2020 +0200 Fix a check for whether Emacs can play sounds in eudc-bob * lisp/net/eudc-bob.el (eudc-bob-sound-menu) (eudc-bob-play-sound-at-point): Check for play-sound-internal instead of play-sound, because the latter is always defined. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 20a5c5f607..b248c88d49 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -71,7 +71,7 @@ `("EUDC Sound Menu" ["---" nil nil] ["Play sound" eudc-bob-play-sound-at-point - (fboundp 'play-sound)] + (fboundp 'play-sound-internal)] ,@(cdr (cdr eudc-bob-generic-menu)))) (defun eudc-jump-to-event (event) @@ -197,7 +197,7 @@ display a button." (let (sound) (if (null (setq sound (eudc-bob-get-overlay-prop 'object-data))) (error "No sound data available here") - (unless (fboundp 'play-sound) + (unless (fboundp 'play-sound-internal) (error "Playing sounds not supported on this system")) (play-sound (list 'sound :data sound))))) commit 6ac22bc00cbdd8b42269af79c2dca4e89e001ff9 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:35:29 2020 +0200 Remove some compat code from allout.el * lisp/allout.el (allout-numbered-bullet) (allout-file-xref-bullet): string-or-null-p is always defined. diff --git a/lisp/allout.el b/lisp/allout.el index f52fa05ef6..05d9153a31 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -722,10 +722,7 @@ disables numbering maintenance." :group 'allout) (make-variable-buffer-local 'allout-numbered-bullet) ;;;###autoload -(put 'allout-numbered-bullet 'safe-local-variable - (if (fboundp 'string-or-null-p) - 'string-or-null-p - (lambda (x) (or (stringp x) (null x))))) +(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p) ;;;_ = allout-file-xref-bullet (defcustom allout-file-xref-bullet "@" "Bullet signifying file cross-references, for `allout-resolve-xref'. @@ -734,10 +731,7 @@ Set this var to the bullet you want to use for file cross-references." :type '(choice (const nil) string) :group 'allout) ;;;###autoload -(put 'allout-file-xref-bullet 'safe-local-variable - (if (fboundp 'string-or-null-p) - 'string-or-null-p - (lambda (x) (or (stringp x) (null x))))) +(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p) ;;;_ = allout-presentation-padding (defcustom allout-presentation-padding 2 "Presentation-format white-space padding factor, for greater indent." commit 67bd8a48747d28473d366d0c96804abc547a1dfd Author: Lars Ingebrigtsen Date: Wed Aug 12 18:34:29 2020 +0200 Remove some compat code from allout*.el * lisp/allout-widgets.el (allout-widgets-mode-inhibit): Ditto. * lisp/allout.el (allout-use-hanging-indents) (allout-show-bodies, allout-old-style-prefixes) (allout-stylish-prefixes): `booleanp' is always defined. diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 2a8dced5e9..159b2aa35b 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -323,8 +323,7 @@ In addition, you can invoked `allout-widgets-mode' allout-mode buffers where this is set to enable and disable widget enhancements, directly.") ;;;###autoload -(put 'allout-widgets-mode-inhibit 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp) (make-variable-buffer-local 'allout-widgets-mode-inhibit) ;;;_ = allout-inhibit-body-modification-hook (defvar allout-inhibit-body-modification-hook nil diff --git a/lisp/allout.el b/lisp/allout.el index fad9a172d0..f52fa05ef6 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -410,8 +410,7 @@ where auto-fill occurs." :group 'allout) (make-variable-buffer-local 'allout-use-hanging-indents) ;;;###autoload -(put 'allout-use-hanging-indents 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp) ;;;_ = allout-reindent-bodies (defcustom allout-reindent-bodies (if allout-use-hanging-indents 'text) @@ -440,8 +439,7 @@ just the header." :group 'allout) (make-variable-buffer-local 'allout-show-bodies) ;;;###autoload -(put 'allout-show-bodies 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-show-bodies 'safe-local-variable 'booleanp) ;;;_ = allout-beginning-of-line-cycles (defcustom allout-beginning-of-line-cycles t @@ -662,8 +660,7 @@ are always respected by the topic maneuvering functions." :group 'allout) (make-variable-buffer-local 'allout-old-style-prefixes) ;;;###autoload -(put 'allout-old-style-prefixes 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp) ;;;_ = allout-stylish-prefixes -- alternating bullets (defcustom allout-stylish-prefixes t "Do fancy stuff with topic prefix bullets according to level, etc. @@ -711,8 +708,7 @@ is non-nil." :group 'allout) (make-variable-buffer-local 'allout-stylish-prefixes) ;;;###autoload -(put 'allout-stylish-prefixes 'safe-local-variable - (if (fboundp 'booleanp) 'booleanp (lambda (x) (member x '(t nil))))) +(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp) ;;;_ = allout-numbered-bullet (defcustom allout-numbered-bullet "#" commit 77907b29e01113ddc66b7880e3ceae441b7289b5 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:31:50 2020 +0200 Remove some compat code from prolog.el * lisp/progmodes/prolog.el (match-string): Remove alias to function that always exists. diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index bdb98a47fa..a209d21807 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2748,20 +2748,6 @@ When called with prefix argument ARG, disable zipping instead." (nth 1 state))) )))) -;; For backward compatibility. Stolen from custom.el. -(or (fboundp 'match-string) - ;; Introduced in Emacs 19.29. - (defun match-string (num &optional string) - "Return string of text matched by last search. -NUM specifies which parenthesized expression in the last regexp. - Value is nil if NUMth pair didn't match, or there were less than NUM pairs. -Zero means the entire text matched by the whole regexp or whole string. -STRING should be given if the last search was by `string-match' on STRING." - (if (match-beginning num) - (if string - (substring string (match-beginning num) (match-end num)) - (buffer-substring (match-beginning num) (match-end num)))))) - (defun prolog-pred-start () "Return the starting point of the first clause of the current predicate." ;; FIXME: Use SMIE. commit a459e5256c2cf2a313db503c2b3f565b03694332 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:29:05 2020 +0200 Remove some compat code from idlwave.el * lisp/progmodes/idlwave.el: Remove some checks for functions that always exist. diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index f4eb2be8cc..f7e53ec02d 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -154,21 +154,6 @@ (eval-when-compile (require 'cl-lib)) (require 'idlw-help) -;; For XEmacs -(unless (fboundp 'line-beginning-position) - (defalias 'line-beginning-position 'point-at-bol)) -(unless (fboundp 'line-end-position) - (defalias 'line-end-position 'point-at-eol)) -(unless (fboundp 'char-valid-p) - (defalias 'char-valid-p 'characterp)) -(unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) - -(if (not (fboundp 'cancel-timer)) - (condition-case nil - (require 'timer) - (error nil))) - (declare-function idlwave-shell-get-path-info "idlw-shell") (declare-function idlwave-shell-temp-file "idlw-shell") (declare-function idlwave-shell-is-running "idlw-shell") commit 51ea541710e251b7147ace80a227dcbfbe865fb5 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:26:20 2020 +0200 Remove some compat code from ediff-init.el * lisp/vc/ediff-init.el (subst-char-in-string, format-message): Remove aliases to functions that always exist. diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index da6509b7cb..f5177bca11 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -1513,21 +1513,6 @@ This default should work without changes." (defsubst ediff-nonempty-string-p (string) (and (stringp string) (not (string= string "")))) -(unless (fboundp 'subst-char-in-string) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. -Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) - -(unless (fboundp 'format-message) - (defalias 'format-message 'format)) - (defun ediff-abbrev-jobname (jobname) (cond ((eq jobname 'ediff-directories) "Compare two directories") commit 6cddb736e404f7f4bf15f6644a003aadd56685c2 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:09:24 2020 +0200 Check make-process to determine if we support multi-processing * lisp/eshell/esh-proc.el (eshell-gather-process-output): * lisp/comint.el (make-comint-in-buffer): Check that make-process exists instead of start-file-process (which always exists). diff --git a/lisp/comint.el b/lisp/comint.el index df947b93af..c3cb439d8b 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -735,7 +735,7 @@ contents are sent to the process as its initial input. If PROGRAM is a string, any more args are arguments to PROGRAM. Return the (possibly newly created) process buffer." - (or (fboundp 'start-file-process) + (or (fboundp 'make-process) (error "Multi-processing is not supported for this system")) (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d2c17fe1f7..db1b258c8f 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -295,7 +295,7 @@ See `eshell-needs-pipe'." (process-environment (eshell-environment-variables)) proc decoding encoding changed) (cond - ((fboundp 'start-file-process) + ((fboundp 'make-process) (setq proc (let ((process-connection-type (unless (eshell-needs-pipe-p command) commit e3a08019933cd1ebfadc32fe9934cc202b25ba47 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:06:50 2020 +0200 Revert "Remove compat code from esh-proc.el" This reverts commit 97c4d941daffba1635bd738fae9c4ff36e5ad0cf. We still have Emacs builds on systems with no multi-tasking. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index f612e875ff..d2c17fe1f7 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -294,40 +294,91 @@ See `eshell-needs-pipe'." delete-exited-processes)) (process-environment (eshell-environment-variables)) proc decoding encoding changed) - (setq proc - (let ((process-connection-type - (unless (eshell-needs-pipe-p command) - process-connection-type)) - (command (file-local-name (expand-file-name command)))) - (apply #'start-file-process - (file-name-nondirectory command) nil command args))) - (eshell-record-process-object proc) - (set-process-buffer proc (current-buffer)) - (set-process-filter proc (if (eshell-interactive-output-p) - #'eshell-output-filter - #'eshell-insertion-filter)) - (set-process-sentinel proc #'eshell-sentinel) - (run-hook-with-args 'eshell-exec-hook proc) - (when (fboundp 'process-coding-system) - (let ((coding-systems (process-coding-system proc))) - (setq decoding (car coding-systems) - encoding (cdr coding-systems))) - ;; If start-process decided to use some coding system for - ;; decoding data sent from the process and the coding system - ;; doesn't specify EOL conversion, we had better convert CRLF - ;; to LF. - (if (vectorp (coding-system-eol-type decoding)) - (setq decoding (coding-system-change-eol-conversion decoding 'dos) - changed t)) - ;; Even if start-process left the coding system for encoding - ;; data sent from the process undecided, we had better use the - ;; same one as what we use for decoding. But, we should - ;; suppress EOL conversion. - (if (and decoding (not encoding)) - (setq encoding (coding-system-change-eol-conversion decoding 'unix) - changed t)) - (if changed - (set-process-coding-system proc decoding encoding))) + (cond + ((fboundp 'start-file-process) + (setq proc + (let ((process-connection-type + (unless (eshell-needs-pipe-p command) + process-connection-type)) + (command (file-local-name (expand-file-name command)))) + (apply #'start-file-process + (file-name-nondirectory command) nil command args))) + (eshell-record-process-object proc) + (set-process-buffer proc (current-buffer)) + (set-process-filter proc (if (eshell-interactive-output-p) + #'eshell-output-filter + #'eshell-insertion-filter)) + (set-process-sentinel proc #'eshell-sentinel) + (run-hook-with-args 'eshell-exec-hook proc) + (when (fboundp 'process-coding-system) + (let ((coding-systems (process-coding-system proc))) + (setq decoding (car coding-systems) + encoding (cdr coding-systems))) + ;; If start-process decided to use some coding system for + ;; decoding data sent from the process and the coding system + ;; doesn't specify EOL conversion, we had better convert CRLF + ;; to LF. + (if (vectorp (coding-system-eol-type decoding)) + (setq decoding (coding-system-change-eol-conversion decoding 'dos) + changed t)) + ;; Even if start-process left the coding system for encoding + ;; data sent from the process undecided, we had better use the + ;; same one as what we use for decoding. But, we should + ;; suppress EOL conversion. + (if (and decoding (not encoding)) + (setq encoding (coding-system-change-eol-conversion decoding 'unix) + changed t)) + (if changed + (set-process-coding-system proc decoding encoding)))) + (t + ;; No async subprocesses... + (let ((oldbuf (current-buffer)) + (interact-p (eshell-interactive-output-p)) + lbeg lend line proc-buf exit-status) + (and (not (markerp eshell-last-sync-output-start)) + (setq eshell-last-sync-output-start (point-marker))) + (setq proc-buf + (set-buffer (get-buffer-create eshell-scratch-buffer))) + (erase-buffer) + (set-buffer oldbuf) + (run-hook-with-args 'eshell-exec-hook command) + (setq exit-status + (apply #'call-process-region + (append (list eshell-last-sync-output-start (point) + command t + eshell-scratch-buffer nil) + args))) + ;; When in a pipeline, record the place where the output of + ;; this process will begin. + (and (bound-and-true-p eshell-in-pipeline-p) + (set-marker eshell-last-sync-output-start (point))) + ;; Simulate the effect of the process filter. + (when (numberp exit-status) + (set-buffer proc-buf) + (goto-char (point-min)) + (setq lbeg (point)) + (while (eq 0 (forward-line 1)) + (setq lend (point) + line (buffer-substring-no-properties lbeg lend)) + (set-buffer oldbuf) + (if interact-p + (eshell-output-filter nil line) + (eshell-output-object line)) + (setq lbeg lend) + (set-buffer proc-buf)) + (set-buffer oldbuf)) + (require 'esh-mode) + (declare-function eshell-update-markers "esh-mode" (pmark)) + (defvar eshell-last-output-end) ;Defined in esh-mode.el. + (eshell-update-markers eshell-last-output-end) + ;; Simulate the effect of eshell-sentinel. + (eshell-close-handles (if (numberp exit-status) exit-status -1)) + (eshell-kill-process-function command exit-status) + (or (bound-and-true-p eshell-in-pipeline-p) + (setq eshell-last-sync-output-start nil)) + (if (not (numberp exit-status)) + (error "%s: external command failed: %s" command exit-status)) + (setq proc t)))) proc)) (defun eshell-insertion-filter (proc string) commit a5b24a0c44dd603942c8cf531b47a3905927d3f4 Author: Lars Ingebrigtsen Date: Wed Aug 12 18:06:13 2020 +0200 Revert "Remove compat code from comint.el" This reverts commit 4d00db5538dc0ef47cf1cdf425b895d04145fe9e. We still have Emacs builds on systems with no multi-taskin. diff --git a/lisp/comint.el b/lisp/comint.el index 843cba1483..df947b93af 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -735,6 +735,8 @@ contents are sent to the process as its initial input. If PROGRAM is a string, any more args are arguments to PROGRAM. Return the (possibly newly created) process buffer." + (or (fboundp 'start-file-process) + (error "Multi-processing is not supported for this system")) (setq buffer (get-buffer-create (or buffer (concat "*" name "*")))) ;; If no process, or nuked process, crank up a new one and put buffer in ;; comint mode. Otherwise, leave buffer and existing process alone. commit 76098d39c992aa51f5bdb04fb39e40fc5eb409d5 Author: Tino Calancha Date: Wed Aug 12 14:53:29 2020 +0200 Do not truncate /foo//bar to /bar/ in parse-colon-path * lisp/files.el (parse-colon-path): Use substitute-env-vars and expand-file-name instead of substitute-in-file-name (Bug#21454). diff --git a/lisp/files.el b/lisp/files.el index 1909669346..9270f334af 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -752,10 +752,16 @@ resulting list of directory names. For an empty path element (i.e., a leading or trailing separator, or two adjacent separators), return nil (meaning `default-directory') as the associated list element." (when (stringp search-path) - (mapcar (lambda (f) - (if (equal "" f) nil - (substitute-in-file-name (file-name-as-directory f)))) - (split-string search-path path-separator)))) + (let ((spath (substitute-env-vars search-path))) + (mapcar (lambda (f) + (if (equal "" f) nil + (let ((dir (expand-file-name (file-name-as-directory f)))) + ;; Previous implementation used `substitute-in-file-name' + ;; which collapse multiple "/" in front. Do the same for + ;; backward compatibility. + (if (string-match "\\`/+" dir) + (substring dir (1- (match-end 0))) dir)))) + (split-string spath path-separator))))) (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 4b902fd82a..5b2f5fd6f0 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -190,7 +190,6 @@ form.") (ert-deftest files-tests-bug-21454 () "Test for https://debbugs.gnu.org/21454 ." - :expected-result :failed (let ((input-result '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/")) ("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) @@ -1362,5 +1361,9 @@ See ." (normal-mode) (should (not (eq major-mode 'text-mode)))))) +(ert-deftest files-colon-path () + (should (equal (parse-colon-path "/foo//bar/baz") + '("/foo/bar/baz/")))) + (provide 'files-tests) ;;; files-tests.el ends here commit a5a0a9c9ca0f0485db2c324a30109f655522800d Author: Stefan Kangas Date: Wed Aug 12 15:43:23 2020 +0200 Remove Emacs 23 compat code from checkdoc.el * lisp/emacs-lisp/checkdoc.el (checkdoc-run-hooks): Redefine as obsolete function alias for 'run-hook-with-args-until-success'. (checkdoc-this-string-valid-engine) (checkdoc-file-comments-engine): Adjust callers. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index e4b800786c..1029b52220 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1249,13 +1249,8 @@ checking of documentation strings. ;;; Subst utils ;; -(defsubst checkdoc-run-hooks (hookvar &rest args) - "Run hooks in HOOKVAR with ARGS." - (if (fboundp 'run-hook-with-args-until-success) - (apply #'run-hook-with-args-until-success hookvar args) - ;; This method was similar to above. We ignore the warning - ;; since we will use the above for future Emacs versions - (apply #'run-hook-with-args hookvar args))) +(define-obsolete-function-alias 'checkdoc-run-hooks + #'run-hook-with-args-until-success "28.1") (defsubst checkdoc-create-common-verbs-regexp () "Rebuild the contents of `checkdoc-common-verbs-regexp'." @@ -1873,7 +1868,7 @@ Replace with \"%s\"? " original replace) ;; and reliance on the Ispell program. (checkdoc-ispell-docstring-engine e take-notes) ;; User supplied checks - (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e)) + (save-excursion (run-hook-with-args-until-success 'checkdoc-style-functions fp e)) ;; Done! ))) @@ -2384,7 +2379,7 @@ Code:, and others referenced in the style guide." err (or ;; Generic Full-file checks (should be comment related) - (checkdoc-run-hooks 'checkdoc-comment-style-functions) + (run-hook-with-args-until-success 'checkdoc-comment-style-functions) err)) ;; Done with full file comment checks err))) commit 68ff32a51ef83d24a03dd55c66df71c0dda9010d Author: Stefan Kangas Date: Wed Aug 12 15:34:13 2020 +0200 Minor cleanup in ps-def.el * lisp/ps-def.el (ps-frame-parameter): Make alias obsolete. * lisp/ps-print.el (ps-begin-job): Adjust caller. diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 49d72d3be5..f532511b97 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -55,7 +55,7 @@ (face-background face nil t)) -(defalias 'ps-frame-parameter 'frame-parameter) +(define-obsolete-function-alias 'ps-frame-parameter #'frame-parameter "28.1") ;; Return t if the device (which can be changed during an emacs session) can ;; handle colors. This function is not yet implemented for GNU emacs. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index ace3001781..17b486bca1 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -5761,7 +5761,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-bg 'frame-parameter) - (ps-frame-parameter nil 'background-color)) + (frame-parameter nil 'background-color)) ((eq ps-default-bg t) (ps-face-background-name 'default)) (t @@ -5775,7 +5775,7 @@ XSTART YSTART are the relative position for the first page in a sheet.") (eq genfunc 'ps-generate-postscript)) nil) ((eq ps-default-fg 'frame-parameter) - (ps-frame-parameter nil 'foreground-color)) + (frame-parameter nil 'foreground-color)) ((eq ps-default-fg t) (ps-face-foreground-name 'default)) (t commit fdba95d2f8cc557b9b214c21f54bc8467900c763 Author: YAMAMOTO Mitsuharu Date: Wed Aug 12 13:15:44 2020 +0200 Fix monospace font calculations on macOS * src/macfont.m (macfont_monospace_width_multiplier): New function to compute the width for monospace fonts (bug#24582). (macfont_glyph_extents): Fix monospace glyph computation. (macfont_shape): Ditto. diff --git a/src/macfont.m b/src/macfont.m index 21bc7dde5b..c7430d3277 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -1120,7 +1120,10 @@ sorted in the canonical order (CTFontManagerCompareFontFamilyNames on glyph width. The `width_int' member is an integer that is closest to the width. The `width_frac' member is the fractional adjustment representing a value in [-.5, .5], multiplied by - WIDTH_FRAC_SCALE. For synthetic monospace fonts, they represent + WIDTH_FRAC_SCALE. For monospace fonts, non-zero `width_frac' + means `width_int' is further adjusted to a multiple of the + (rounded) font width, and `width_frac' represents adjustment per + unit character. For synthetic monospace fonts, they represent the advance delta for centering instead of the glyph width. */ signed width_frac : WIDTH_FRAC_BITS, width_int : 16 - WIDTH_FRAC_BITS; }; @@ -1148,6 +1151,27 @@ sorted in the canonical order (CTFontManagerCompareFontFamilyNames on #define LCD_FONT_SMOOTHING_LEFT_MARGIN (0.396f) #define LCD_FONT_SMOOTHING_RIGHT_MARGIN (0.396f) +/* If FONT is monospace and WIDTH can be regarded as a multiple of its + width where the multiplier is greater than 1, then return the + multiplier. Otherwise return 0. */ +static int +macfont_monospace_width_multiplier (struct font *font, CGFloat width) +{ + struct macfont_info *macfont_info = (struct macfont_info *) font; + int multiplier = 0; + + if (macfont_info->spacing == MACFONT_SPACING_MONO + && font->space_width != 0) + { + multiplier = lround (width / font->space_width); + if (multiplier == 1 + || lround (width / multiplier) != font->space_width) + multiplier = 0; + } + + return multiplier; +} + static int macfont_glyph_extents (struct font *font, CGGlyph glyph, struct font_metrics *metrics, CGFloat *advance_delta, @@ -1192,13 +1216,38 @@ sorted in the canonical order (CTFontManagerCompareFontFamilyNames on else fwidth = mac_font_get_advance_width_for_glyph (macfont, glyph); - /* For synthetic mono fonts, cache->width_{int,frac} holds the - advance delta value. */ - if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO) - fwidth = (font->pixel_size - fwidth) / 2; - cache->width_int = lround (fwidth); - cache->width_frac = lround ((fwidth - cache->width_int) - * WIDTH_FRAC_SCALE); + if (macfont_info->spacing == MACFONT_SPACING_MONO) + { + /* Some monospace fonts for programming languages contain + wider ligature glyphs consisting of multiple characters. + For such glyphs, simply rounding the combined fractional + width to an integer can result in a value that is not a + multiple of the (rounded) font width. */ + int multiplier = macfont_monospace_width_multiplier (font, fwidth); + + if (multiplier) + { + cache->width_int = font->space_width * multiplier; + cache->width_frac = lround ((fwidth / multiplier + - font->space_width) + * WIDTH_FRAC_SCALE); + } + else + { + cache->width_int = lround (fwidth); + cache->width_frac = 0; + } + } + else + { + /* For synthetic mono fonts, cache->width_{int,frac} holds + the advance delta value. */ + if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO) + fwidth = (font->pixel_size - fwidth) / 2; + cache->width_int = lround (fwidth); + cache->width_frac = lround ((fwidth - cache->width_int) + * WIDTH_FRAC_SCALE); + } METRICS_SET_STATUS (cache, METRICS_WIDTH_VALID); } if (macfont_info->spacing == MACFONT_SPACING_SYNTHETIC_MONO) @@ -1235,6 +1284,10 @@ sorted in the canonical order (CTFontManagerCompareFontFamilyNames on / (CGFloat) (WIDTH_FRAC_SCALE * 2)); break; case MACFONT_SPACING_MONO: + if (cache->width_frac) + bounds.origin.x += - ((cache->width_frac + / (CGFloat) (WIDTH_FRAC_SCALE * 2)) + * (cache->width_int / font->space_width)); break; case MACFONT_SPACING_SYNTHETIC_MONO: bounds.origin.x += (cache->width_int @@ -1271,7 +1324,16 @@ sorted in the canonical order (CTFontManagerCompareFontFamilyNames on / (CGFloat) (WIDTH_FRAC_SCALE * 2))); break; case MACFONT_SPACING_MONO: - *advance_delta = 0; + if (cache->width_frac) + *advance_delta = 0; + else + { + CGFloat delta = - ((cache->width_frac + / (CGFloat) (WIDTH_FRAC_SCALE * 2)) + * (cache->width_int / font->space_width)); + + *advance_delta = (force_integral_p ? round (delta) : delta); + } break; case MACFONT_SPACING_SYNTHETIC_MONO: *advance_delta = (force_integral_p ? cache->width_int @@ -3015,7 +3077,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no struct mac_glyph_layout *gl = glyph_layouts + i; EMACS_INT from, to; struct font_metrics metrics; - int xoff, yoff, wadjust; + int xoff, yoff, wadjust, multiplier; if (NILP (lglyph)) { @@ -3068,7 +3130,11 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no xoff = lround (gl->advance_delta); yoff = lround (- gl->baseline_delta); - wadjust = lround (gl->advance); + multiplier = macfont_monospace_width_multiplier (font, gl->advance); + if (multiplier) + wadjust = font->space_width * multiplier; + else + wadjust = lround (gl->advance); if (xoff != 0 || yoff != 0 || wadjust != metrics.width) { Lisp_Object vec = make_uninit_vector (3); commit 88567ca8ecb505a59157af6338ebe355a304182b Author: Mingde (Matthew) Zeng Date: Wed Aug 12 13:09:35 2020 +0200 Fix erc-reuse-buffers behavior * lisp/erc/erc.el (erc-generate-new-buffer-name): Fixes behavior 1, also determines if the '#channel/server' buffer already exists and will reuse that buffer when joining on the same server. Additionally when creating a new buffer with '#channel/serverB', the existing buffer '#channel' on 'severA' will be renamed to '#channel/serverA' for the sake of consistency (bug#40121). * lisp/erc/erc-join.el (erc-autojoin-channels): The logic is simplified ensuring that when autojoining channels specified in erc-autojoin-channels-alist, if there exists an erc buffer with the same channel name but a different server, it will create a new buffer to join the channel. The current logic is very weak that will skip joining same channel on different servers altogether. By the definition of erc-reuse-buffers, if non-nil it should create a new buffer when joining channels with same names on different servers. The current behavior of erc-reuse-buffers is: 1. when non-nil, it will always reuse the same channel buffer, resulting in server A's channel gets reconnected to the channel with the same name of server B. 2. when nil, the buffer-name of the joined channel is '#channel/server'. However if one tries to '/join #channel' from the server buffer, it creates a new empty buffer with buffer-name '#channel', instead of opening the already-joined channel buffer. diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index e4faf6bd79..79c111082f 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -153,18 +153,20 @@ This function is run from `erc-nickserv-identified-hook'." 'erc-autojoin-channels-delayed server nick (current-buffer)))) ;; `erc-autojoin-timing' is `connect': - (dolist (l erc-autojoin-channels-alist) - (when (string-match (car l) server) - (let ((server (or erc-session-server erc-server-announced-name))) + (let ((server (or erc-session-server erc-server-announced-name))) + (dolist (l erc-autojoin-channels-alist) + (when (string-match-p (car l) server) (dolist (chan (cdr l)) - (let ((buffer (erc-get-buffer chan))) - ;; Only auto-join the channels that we aren't already in - ;; using a different nick. + (let ((buffer + (car (erc-buffer-filter + (lambda () + (let ((current (erc-default-target))) + (and (stringp current) + (string-match-p (car l) + (or erc-session-server erc-server-announced-name)) + (string-equal (erc-downcase chan) + (erc-downcase current))))))))) (when (or (not buffer) - ;; If the same channel is joined on another - ;; server the best-effort is to just join - (not (string-match (car l) - (process-name erc-server-process))) (not (with-current-buffer buffer (erc-server-process-alive)))) (erc-server-join-channel server chan)))))))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 404a4c0997..41d7516fbb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1608,36 +1608,47 @@ symbol, it may have these values: (defun erc-generate-new-buffer-name (server port target) "Create a new buffer name based on the arguments." (when (numberp port) (setq port (number-to-string port))) - (let ((buf-name (or target - (or (let ((name (concat server ":" port))) - (when (> (length name) 1) - name)) - ;; This fallback should in fact never happen - "*erc-server-buffer*"))) - buffer-name) + (let* ((buf-name (or target + (let ((name (concat server ":" port))) + (when (> (length name) 1) + name)) + ;; This fallback should in fact never happen. + "*erc-server-buffer*")) + (full-buf-name (concat buf-name "/" server)) + (dup-buf-name (buffer-name (car (erc-channel-list nil)))) + buffer-name) ;; Reuse existing buffers, but not if the buffer is a connected server ;; buffer and not if its associated with a different server than the ;; current ERC buffer. - ;; if buf-name is taken by a different connection (or by something !erc) - ;; then see if "buf-name/server" meets the same criteria - (dolist (candidate (list buf-name (concat buf-name "/" server))) - (if (and (not buffer-name) - erc-reuse-buffers - (or (not (get-buffer candidate)) - ;; Looking for a server buffer, so there's no target. - (and (not target) - (with-current-buffer (get-buffer candidate) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) - ;; Channel buffer; check that it's from the right server. - (and target - (with-current-buffer (get-buffer candidate) - (and (string= erc-session-server server) - (erc-port-equal erc-session-port port)))))) - (setq buffer-name candidate))) - ;; if buffer-name is unset, neither candidate worked out for us, + ;; If buf-name is taken by a different connection (or by something !erc) + ;; then see if "buf-name/server" meets the same criteria. + (if (and dup-buf-name (string-match-p (concat buf-name "/") dup-buf-name)) + (setq buffer-name full-buf-name) ; ERC buffer with full name already exists. + (dolist (candidate (list buf-name full-buf-name)) + (if (and (not buffer-name) + erc-reuse-buffers + (or (not (get-buffer candidate)) + ;; Looking for a server buffer, so there's no target. + (and (not target) + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) + ;; Channel buffer; check that it's from the right server. + (and target + (with-current-buffer (get-buffer candidate) + (and (string= erc-session-server server) + (erc-port-equal erc-session-port port)))))) + (setq buffer-name candidate) + (when (and (not buffer-name) (get-buffer buf-name) erc-reuse-buffers) + ;; A new buffer will be created with the name buf-name/server, rename + ;; the existing name-duplicated buffer with the same format as well. + (with-current-buffer (get-buffer buf-name) + (when (derived-mode-p 'erc-mode) ; ensure it's an erc buffer + (rename-buffer + (concat buf-name "/" (or erc-session-server erc-server-announced-name))))))))) + ;; If buffer-name is unset, neither candidate worked out for us, ;; fallback to the old uniquification method: - (or buffer-name (generate-new-buffer-name (concat buf-name "/" server))))) + (or buffer-name (generate-new-buffer-name full-buf-name)))) (defun erc-get-buffer-create (server port target) "Create a new buffer based on the arguments." @@ -3153,16 +3164,18 @@ were most recently invited. See also `invitation'." (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. - (let ((joined-channels - (mapcar #'(lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) - (erc-channel-list erc-server-process)))) - (if (erc-member-ignore-case chnl joined-channels) - (switch-to-buffer (car (erc-member-ignore-case chnl - joined-channels))) - (let ((server (with-current-buffer (process-buffer erc-server-process) - (or erc-session-server erc-server-announced-name)))) - (erc-server-join-channel server chnl key)))))) + (let* ((joined-channels + (mapcar #'(lambda (chanbuf) + (with-current-buffer chanbuf (erc-default-target))) + (erc-channel-list erc-server-process))) + (server (with-current-buffer (process-buffer erc-server-process) + (or erc-session-server erc-server-announced-name))) + (chnl-name (car (erc-member-ignore-case chnl joined-channels)))) + (if chnl-name + (switch-to-buffer (if (get-buffer chnl-name) + chnl-name + (concat chnl-name "/" server))) + (erc-server-join-channel server chnl key))))) t) (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) commit 34c17cd8d61a841dcca4c307bc436b5d09b5a965 Author: Michael Albinus Date: Wed Aug 12 12:45:45 2020 +0200 Implement Tramp direct async processes fallback for multi-hops * doc/misc/tramp.texi (Remote processes): Precise restrictions for direct async processes. * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Use `tramp-direct-async-process-p'. * lisp/net/tramp.el (tramp-direct-async-process-p): New defun. (tramp-handle-make-process): Adapt handling of :stderr. Simplify. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 23221b6a7b..c1a66d0251 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3561,23 +3561,23 @@ which must be set to a non-@code{nil} value. Example: @end group @end lisp -However, this approach has different limitations: +Using direct asynchronous processes in @value{tramp} is not possible, +if the remote host is connected via multiple hops +(@pxref{Multi-hops}), or the @code{make-process} / +@code{start-file-process} call uses a stderr stream. In this case, +@value{tramp} falls back to its classical implementation. + +Furthermore, this approach has the following limitations: @itemize @item It works only for connection methods defined in @file{tramp-sh.el} and @file{tramp-adb.el}. -@item -It does not support multi-hop methods. - @item It does not support interactive user authentication, like password handling. -@item -It does not support a separated error stream. - @item It cannot be killed via @code{interrupt-process}. @@ -3594,7 +3594,10 @@ It does not set environment variable @env{INSIDE_EMACS}. In order to gain even more performance, it is recommended to bind @code{tramp-verbose} to 0 when running @code{make-process} or -@code{start-file-process}. +@code{start-file-process}. Furthermore, you might set +@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to +bypass @value{tramp}'s handling of the @code{ControlMaster} options, +and use your own settings in @file{~/.ssh/config}. @node Cleanup remote connections diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 88f5c2928e..49ecaa58ee 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -890,8 +890,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `make-process' for Tramp files. If connection property \"direct-async-process\" is non-nil, an alternative implementation will be used." - (if (tramp-get-connection-property - (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3e2eb023a3..ca43475f45 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2790,8 +2790,7 @@ the result will be a local, non-Tramp, file name." STDERR can also be a file name. If connection property \"direct-async-process\" is non-nil, an alternative implementation will be used." - (if (tramp-get-connection-property - (tramp-dissect-file-name default-directory) "direct-async-process" nil) + (if (tramp-direct-async-process-p args) (apply #'tramp-handle-make-process args) (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d8113a9af9..ab52bec39e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3633,18 +3633,29 @@ User is always nil." (load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) + +(defun tramp-direct-async-process-p (&rest args) + "Whether direct async `make-process' can be called." + (let ((v (tramp-dissect-file-name default-directory))) + (and (tramp-get-connection-property v"direct-async-process" nil) + (not (tramp-multi-hop-p v)) + (not (plist-get args :stderr))))) + ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. (defun tramp-handle-make-process (&rest args) - "An alternative `make-process' implementation for Tramp files." + "An alternative `make-process' implementation for Tramp files. +It does not support `:stderr'." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let ((name (plist-get args :name)) (buffer (plist-get args :buffer)) (command (plist-get args :command)) + ;; FIXME: `:coding' shall be used. (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) + ;; FIXME: `:connection-type' shall be used. (connection-type (plist-get args :connection-type)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) @@ -3667,11 +3678,12 @@ User is always nil." (signal 'wrong-type-argument (list #'functionp filter))) (unless (or (null sentinel) (functionp sentinel)) (signal 'wrong-type-argument (list #'functionp sentinel))) - (unless (or (null stderr) (bufferp stderr) (stringp stderr)) - (signal 'wrong-type-argument (list #'stringp stderr))) - (when (and (stringp stderr) (tramp-tramp-file-p stderr) - (not (tramp-equal-remote default-directory stderr))) - (signal 'file-error (list "Wrong stderr" stderr))) + (when stderr + (signal + 'user-error + (list + "Stderr not supported for direct remote asynchronous processes" + stderr))) (let* ((buffer (if buffer @@ -3698,9 +3710,12 @@ User is always nil." (tramp-set-connection-property v "process-name" name) (tramp-set-connection-property v "process-buffer" buffer) + ;; Check for `tramp-sh-file-name-handler', because something + ;; is different between tramp-adb.el and tramp-sh.el. (with-current-buffer (tramp-get-connection-buffer v) (unwind-protect - (let* ((login-program + (let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v)) + (login-program (tramp-get-method-parameter v 'tramp-login-program)) (login-args (tramp-get-method-parameter v 'tramp-login-args)) @@ -3716,12 +3731,12 @@ User is always nil." ;; in the main connection process, therefore ;; we cannot use `tramp-get-connection-process'. (tmpfile - (when (tramp-sh-file-name-handler-p v) + (when sh-file-name-handler-p (with-tramp-connection-property (tramp-get-process v) "temp-file" (tramp-compat-make-temp-name)))) (options - (when (tramp-sh-file-name-handler-p v) + (when sh-file-name-handler-p (tramp-compat-funcall 'tramp-ssh-controlmaster-options v))) spec) commit 79236fcbd01998862f565da07a70611bc8b802d2 Author: Glenn Morris Date: Wed Aug 12 11:41:17 2020 +0100 ; Fix copyright years for recent additions diff --git a/src/nsxwidget.h b/src/nsxwidget.h index 521601922f..3d91594c34 100644 --- a/src/nsxwidget.h +++ b/src/nsxwidget.h @@ -1,6 +1,6 @@ /* Header for NS Cocoa part of xwidget and webkit widget. -Copyright (C) 2019 Free Software Foundation, Inc. +Copyright (C) 2019-2020 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/nsxwidget.m b/src/nsxwidget.m index 2277cc97d5..370abee395 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -1,6 +1,6 @@ /* NS Cocoa part implementation of xwidget and webkit widget. -Copyright (C) 2019 Free Software Foundation, Inc. +Copyright (C) 2019-2020 Free Software Foundation, Inc. This file is part of GNU Emacs. commit c25321e44707253381c2ab92033e8d57ff00c746 Author: Sungbin Jo Date: Wed Aug 12 12:39:50 2020 +0200 Add utility functions and new xwidget commands Co-authored-by: Jaesup Kwak * lisp/xwidget.el (xwidget-webkit-callback): Add case for 'response-callback' event. (xwidget-webkit-download-dir): New variable. (xwidget-webkit-save-as-file): New function. * src/nsxwidget.m (XwWebView::decidePolicyForNavigationResponse): Store download event. * src/xwidget.c src/xwidget.h (store_xwidget_download_callback_event): New function. diff --git a/etc/NEWS b/etc/NEWS index cfe180ff68..b25e43bb9b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -986,6 +986,9 @@ If Emacs was built with xwidget support, you can access the embedded webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two instances of xwidget webkit is not supported. +*** Downloading files from xwidget-webkit is now supported. +The new variable 'xwidget-webkit-download-dir' says where to download to. + *** New functions for xwidget-webkit mode 'xwidget-webkit-clone-and-split-below', 'xwidget-webkit-clone-and-split-right'. diff --git a/lisp/xwidget.el b/lisp/xwidget.el index e38bd1b32f..074320855c 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -288,6 +288,12 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))) + ;; TODO: Response handling other than download. + ((eq xwidget-event-type 'download-callback) + (let ((url (nth 3 last-input-event)) + (mime-type (nth 4 last-input-event)) + (file-name (nth 5 last-input-event))) + (xwidget-webkit-save-as-file url mime-type file-name))) ((eq xwidget-event-type 'javascript-callback) (let ((proc (nth 3 last-input-event)) (arg (nth 4 last-input-event))) @@ -308,6 +314,32 @@ If non-nil, plugins are enabled. Otherwise, disabled.")) ;; Keep track of [vh]scroll when switching buffers (image-mode-setup-winprops)) +;;; Download, save as file. + +(defcustom xwidget-webkit-download-dir "~/Downloads/" + "Directory where download file saved." + :version "27.1" + :type 'file) + +(defun xwidget-webkit-save-as-file (url mime-type file-name) + "For XWIDGET webkit, save URL of MIME-TYPE to location specified by user. +FILE-NAME combined with `xwidget-webkit-download-dir' is the default file name +of the prompt when reading. When the file name the user specified is a +directory, URL is saved at the specified directory as FILE-NAME." + (let ((save-name (read-file-name + (format "Save URL `%s' of type `%s' in file/directory: " + url mime-type) + xwidget-webkit-download-dir + (when file-name + (expand-file-name + file-name + xwidget-webkit-download-dir))))) + (if (file-directory-p save-name) + (setq save-name + (expand-file-name (file-name-nondirectory file-name) save-name))) + (setq xwidget-webkit-download-dir (file-name-directory save-name)) + (url-copy-file url save-name t))) + ;;; Bookmarks integration (defcustom xwidget-webkit-bookmark-jump-new-session nil diff --git a/src/nsxwidget.m b/src/nsxwidget.m index 8643ba24d8..2277cc97d5 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -121,6 +121,18 @@ - (void)webView:(WKWebView *)webView decidePolicyForNavigationResponse:(WKNavigationResponse *)navigationResponse decisionHandler:(void (^)(WKNavigationResponsePolicy))decisionHandler { + if (!navigationResponse.canShowMIMEType) + { + NSString *url = navigationResponse.response.URL.absoluteString; + NSString *mimetype = navigationResponse.response.MIMEType; + NSString *filename = navigationResponse.response.suggestedFilename; + decisionHandler (WKNavigationResponsePolicyCancel); + store_xwidget_download_callback_event (self.xw, + url.UTF8String, + mimetype.UTF8String, + filename.UTF8String); + return; + } decisionHandler (WKNavigationResponsePolicyAllow); self.urlScriptBlocked[navigationResponse.response.URL] = diff --git a/src/xwidget.c b/src/xwidget.c index d5c229c2b1..c61f5bef88 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -258,6 +258,26 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname, kbd_buffer_store_event (&event); } +void +store_xwidget_download_callback_event (struct xwidget *xw, + const char *url, + const char *mimetype, + const char *filename) +{ + struct input_event event; + Lisp_Object xwl; + XSETXWIDGET (xwl, xw); + EVENT_INIT (event); + event.kind = XWIDGET_EVENT; + event.frame_or_window = Qnil; + event.arg = list5 (intern ("download-callback"), + xwl, + build_string (url), + build_string (mimetype), + build_string (filename)); + kbd_buffer_store_event (&event); +} + void store_xwidget_js_callback_event (struct xwidget *xw, Lisp_Object proc, diff --git a/src/xwidget.h b/src/xwidget.h index 29f1153206..40ad8ae833 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -154,6 +154,11 @@ void store_xwidget_event_string (struct xwidget *xw, const char *eventname, const char *eventstr); +void store_xwidget_download_callback_event (struct xwidget *xw, + const char *url, + const char *mimetype, + const char *filename); + void store_xwidget_js_callback_event (struct xwidget *xw, Lisp_Object proc, Lisp_Object argument); commit 9e1af8251fe241fa163e721f3e796c1e8cca86cf Author: Sungbin Jo Date: Wed Aug 12 12:34:29 2020 +0200 Add utility functions and new xwidget commands Co-authored-by: Jaesup Kwak * etc/NEWS: Announce new functions and options. * lisp/xwidget.el (xwidget): New defgroup. (xwidget-webkit-mode-map): Add new keybindings. (xwidget-webkit-scroll-up, xwidget-webkit-scroll-down) (xwidget-webkit-scroll-forward, xwidget-webkit-scroll-backward): Add optional argument to specify specific amounts to scroll down. (xwidget-webkit-scroll-up-line, xwidget-webkit-scroll-down-line): New functions. (xwidget-webkit-scroll-bottom): Fix function to scroll to the bottom of the document. (xwidget-webkit-callback): Use new function to update buffer title even when Javascript is disabled. (xwidget-webkit-bookmark-jump-new-session): New variable. (xwidget-webkit-bookmark-make-record): Modify to use xwidget-webkit to open bookmark that is created in xwidget-webkit. (xwidget-webkit-insert-string): Fix Javascript snippet to not throw Javsscript exceptions. (xwidget-webkit-inside-pixel-width) (xwidget-window-inside-pixel-height): New functions. (xwidget-webkit-adjust-size-to-window): Use new functions. (xwidget-webkit-new-session): Insert invisible URL instead of an empty string to achieve better default behavior. (xwidget-webkit-back, xwidget-webkit-forward, xwidget-webkit-reload) (xwidget-webkit-current-url): Use new functions to enable scrolling even when Javascript is disabled. (xwidget-webkit-copy-selection-as-kill): Remove unnecessary lambda. * src/nsxwidget.h src/nsxwidget.m (nsxwidget_webkit_uri) (nsxwidget_webkit_title, nsxwidget_webkit_goto_history): Add new functions. * src/xwidget.c (Fxwidget_webkit_uri, Fxwidget_webkit_title) (Fxwidget_webkit_goto_history): Add new functions. (syms_of_xwidget): Define new functions. diff --git a/etc/NEWS b/etc/NEWS index 5093336497..cfe180ff68 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -790,6 +790,29 @@ never be narrower than 19 characters. When the 'bookmark.el' library is loaded, a customize choice is added to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. + +** xwidget-webkit mode + +*** New xwidget functions +'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title' +(return the current title), and 'xwidget-webkit-goto-history' (goto a +point in history). + +*** Pixel-based scrolling +The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands +now supports scrolling arbitrary pixel values. It now treats the +optional 2nd argument as the pixel values to scroll. + +*** New commands for scrolling +The new commands 'xwidget-webkit-scroll-up-line', +'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward', +'xwidget-webkit-scroll-backward' can be used to scroll webkit by the +height of lines or width of chars. + +*** New user option 'xwidget-webkit-bookmark-jump-new-session'. +When non-nil, use a new xwidget webkit session after bookmark jump. +Otherwise, it will use 'xwidget-webkit-last-session'. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/xwidget.el b/lisp/xwidget.el index f0940a9203..e38bd1b32f 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -41,7 +41,10 @@ (declare-function xwidget-resize "xwidget.c" (xwidget new-width new-height)) (declare-function xwidget-webkit-execute-script "xwidget.c" (xwidget script &optional callback)) +(declare-function xwidget-webkit-uri "xwidget.c" (xwidget)) +(declare-function xwidget-webkit-title "xwidget.c" (xwidget)) (declare-function xwidget-webkit-goto-uri "xwidget.c" (xwidget uri)) +(declare-function xwidget-webkit-goto-history "xwidget.c" (xwidget rel-pos)) (declare-function xwidget-webkit-zoom "xwidget.c" (xwidget factor)) (declare-function xwidget-plist "xwidget.c" (xwidget)) (declare-function set-xwidget-plist "xwidget.c" (xwidget plist)) @@ -51,6 +54,10 @@ (declare-function get-buffer-xwidgets "xwidget.c" (buffer)) (declare-function xwidget-query-on-exit-flag "xwidget.c" (xwidget)) +(defgroup xwidget nil + "Displaying native widgets in Emacs buffers." + :group 'widgets) + (defun xwidget-insert (pos type title width height &optional args) "Insert an xwidget at position POS. Supply the xwidget's TYPE, TITLE, WIDTH, and HEIGHT. @@ -78,6 +85,8 @@ This returns the result of `make-xwidget'." ;;; webkit support (require 'browse-url) (require 'image-mode);;for some image-mode alike functionality +(require 'seq) +(require 'url-handlers) ;;;###autoload (defun xwidget-webkit-browse-url (url &optional new-session) @@ -124,6 +133,7 @@ in `split-window-right' with a new xwidget webkit session." (define-key map "g" 'xwidget-webkit-browse-url) (define-key map "a" 'xwidget-webkit-adjust-size-dispatch) (define-key map "b" 'xwidget-webkit-back) + (define-key map "f" 'xwidget-webkit-forward) (define-key map "r" 'xwidget-webkit-reload) (define-key map "t" (lambda () (interactive) (message "o"))) ;FIXME: ?!? (define-key map "\C-m" 'xwidget-webkit-insert-string) @@ -133,20 +143,21 @@ in `split-window-right' with a new xwidget webkit session." ;;similar to image mode bindings (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up) + (define-key map (kbd "S-SPC") 'xwidget-webkit-scroll-down) (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down) - (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up) + (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up-line) (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up) - (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down) + (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down-line) (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down) (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward) (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward) (define-key map [remap right-char] 'xwidget-webkit-scroll-forward) (define-key map [remap left-char] 'xwidget-webkit-scroll-backward) - (define-key map [remap previous-line] 'xwidget-webkit-scroll-down) - (define-key map [remap next-line] 'xwidget-webkit-scroll-up) + (define-key map [remap previous-line] 'xwidget-webkit-scroll-down-line) + (define-key map [remap next-line] 'xwidget-webkit-scroll-up-line) ;; (define-key map [remap move-beginning-of-line] 'image-bol) ;; (define-key map [remap move-end-of-line] 'image-eol) @@ -165,33 +176,63 @@ in `split-window-right' with a new xwidget webkit session." (interactive) (xwidget-webkit-zoom (xwidget-webkit-current-session) -0.1)) -(defun xwidget-webkit-scroll-up () - "Scroll webkit up." - (interactive) +(defun xwidget-webkit-scroll-up (&optional arg) + "Scroll webkit up by ARG pixels; or full window height if no ARG. +Stop if bottom of page is reached. +Interactively, ARG is the prefix numeric argument. +Negative ARG scrolls down." + (interactive "P") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(0, 50);")) - -(defun xwidget-webkit-scroll-down () - "Scroll webkit down." - (interactive) + (format "window.scrollBy(0, %d);" + (or arg (xwidget-window-inside-pixel-height (selected-window)))))) + +(defun xwidget-webkit-scroll-down (&optional arg) + "Scroll webkit down by ARG pixels; or full window height if no ARG. +Stop if top of page is reached. +Interactively, ARG is the prefix numeric argument. +Negative ARG scrolls up." + (interactive "P") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(0, -50);")) - -(defun xwidget-webkit-scroll-forward () - "Scroll webkit forwards." - (interactive) + (format "window.scrollBy(0, -%d);" + (or arg (xwidget-window-inside-pixel-height (selected-window)))))) + +(defun xwidget-webkit-scroll-up-line (&optional n) + "Scroll webkit up by N lines. +The height of line is calculated with `window-font-height'. +Stop if the bottom edge of the page is reached. +If N is omitted or nil, scroll up by one line." + (interactive "p") + (xwidget-webkit-scroll-up (* n (window-font-height)))) + +(defun xwidget-webkit-scroll-down-line (&optional n) + "Scroll webkit down by N lines. +The height of line is calculated with `window-font-height'. +Stop if the top edge of the page is reached. +If N is omitted or nil, scroll down by one line." + (interactive "p") + (xwidget-webkit-scroll-down (* n (window-font-height)))) + +(defun xwidget-webkit-scroll-forward (&optional n) + "Scroll webkit horizontally by N chars. +The width of char is calculated with `window-font-width'. +If N is ommited or nil, scroll forwards by one char." + (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(50, 0);")) - -(defun xwidget-webkit-scroll-backward () - "Scroll webkit backwards." - (interactive) + (format "window.scrollBy(%d, 0);" + (* n (window-font-width))))) + +(defun xwidget-webkit-scroll-backward (&optional n) + "Scroll webkit back by N chars. +The width of char is calculated with `window-font-width'. +If N is ommited or nil, scroll backwards by one char." + (interactive "p") (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollBy(-50, 0);")) + (format "window.scrollBy(-%d, 0);" + (* n (window-font-width))))) (defun xwidget-webkit-scroll-top () "Scroll webkit to the very top." @@ -205,7 +246,7 @@ in `split-window-right' with a new xwidget webkit session." (interactive) (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "window.scrollTo(pageXOffset, window.document.body.clientHeight);")) + "window.scrollTo(pageXOffset, window.document.body.scrollHeight);")) ;; The xwidget event needs to go into a higher level handler ;; since the xwidget can generate an event even if it's offscreen. @@ -236,15 +277,11 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." "error: callback called for xwidget with dead buffer") (with-current-buffer (xwidget-buffer xwidget) (cond ((eq xwidget-event-type 'load-changed) - (xwidget-webkit-execute-script - xwidget "document.title" - (lambda (title) - (xwidget-log "webkit finished loading: '%s'" title) - ;; Do not adjust webkit size to window here, the - ;; selected window can be the mini-buffer window - ;; unwantedly. - (rename-buffer (format "*xwidget webkit: %s *" title)))) - (pop-to-buffer (current-buffer))) + (let ((title (xwidget-webkit-title xwidget))) + (xwidget-log "webkit finished loading: %s" title) + ;; Do not adjust webkit size to window here, the selected window + ;; can be the mini-buffer window unwantedly. + (rename-buffer (format "*xwidget webkit: %s *" title) t))) ((eq xwidget-event-type 'decide-policy) (let ((strarg (nth 3 last-input-event))) (if (string-match ".*#\\(.*\\)" strarg) @@ -264,20 +301,34 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." If non-nil, plugins are enabled. Otherwise, disabled.")) (define-derived-mode xwidget-webkit-mode - special-mode "xwidget-webkit" "Xwidget webkit view mode." - (setq buffer-read-only t) - (setq-local bookmark-make-record-function - #'xwidget-webkit-bookmark-make-record) - ;; Keep track of [vh]scroll when switching buffers - (image-mode-setup-winprops)) + special-mode "xwidget-webkit" "Xwidget webkit view mode." + (setq buffer-read-only t) + (setq-local bookmark-make-record-function + #'xwidget-webkit-bookmark-make-record) + ;; Keep track of [vh]scroll when switching buffers + (image-mode-setup-winprops)) + +;;; Bookmarks integration + +(defcustom xwidget-webkit-bookmark-jump-new-session nil + "Control bookmark jump to use new session or not. +If non-nil, use a new xwidget webkit session after bookmark jump. +Otherwise, it will use `xwidget-webkit-last-session'. +When you set this variable to nil, consider further customization with +`xwidget-webkit-last-session-buffer'." + :version "27.1" + :type 'boolean) (defun xwidget-webkit-bookmark-make-record () - "Integrate Emacs bookmarks with the webkit xwidget." + "Create bookmark record in webkit xwidget." (nconc (bookmark-make-record-default t t) - `((page . ,(xwidget-webkit-current-url)) - (handler . (lambda (bmk) (browse-url - (bookmark-prop-get bmk 'page))))))) + `((page . ,(xwidget-webkit-uri (xwidget-webkit-current-session))) + (handler . (lambda (bmk) + (xwidget-webkit-browse-url + (bookmark-prop-get bmk 'page) + xwidget-webkit-bookmark-jump-new-session)))))) +;;; xwidget webkit session (defvar xwidget-webkit-last-session-buffer nil) @@ -325,7 +376,7 @@ function findactiveelement(doc){ " - "javascript that finds the active element." + "Javascript that finds the active element." ;; Yes it's ugly, because: ;; - there is apparently no way to find the active frame other than recursion ;; - the js "for each" construct misbehaved on the "frames" collection @@ -335,19 +386,22 @@ function findactiveelement(doc){ ) (defun xwidget-webkit-insert-string () - "Prompt for a string and insert it in the active field in the -current webkit widget." + "Insert string into the active field in the current webkit widget." ;; Read out the string in the field first and provide for edit. (interactive) + ;; As the prompt differs on JavaScript execution results, + ;; the function must handle the prompt itself. (let ((xww (xwidget-webkit-current-session))) (xwidget-webkit-execute-script xww (concat xwidget-webkit-activeelement-js " (function () { var res = findactiveelement(document); - return [res.value, res.type]; + if (res) + return [res.value, res.type]; })();") (lambda (field) + "Prompt a string for the FIELD and insert in the active input." (let ((str (pcase field (`[,val "text"] (read-string "Text: " val)) @@ -466,11 +520,23 @@ For example, use this to display an anchor." (ignore-errors (recenter-top-bottom))) +;; Utility functions + +(defun xwidget-window-inside-pixel-width (window) + "Return Emacs WINDOW body width in pixel." + (let ((edges (window-inside-pixel-edges window))) + (- (nth 2 edges) (nth 0 edges)))) + +(defun xwidget-window-inside-pixel-height (window) + "Return Emacs WINDOW body height in pixel." + (let ((edges (window-inside-pixel-edges window))) + (- (nth 3 edges) (nth 1 edges)))) + (defun xwidget-webkit-adjust-size-to-window (xwidget &optional window) "Adjust the size of the webkit XWIDGET to fit the WINDOW." (xwidget-resize xwidget - (window-pixel-width window) - (window-pixel-height window))) + (xwidget-window-inside-pixel-width window) + (xwidget-window-inside-pixel-height window))) (defun xwidget-webkit-adjust-size (w h) "Manually set webkit size to width W, height H." @@ -510,42 +576,46 @@ For example, use this to display an anchor." (get-buffer-create bufname))) ;; The xwidget id is stored in a text property, so we need to have ;; at least character in this buffer. - (insert " ") - (setq xw (xwidget-insert 1 'webkit bufname - (window-pixel-width) - (window-pixel-height))) + ;; Insert invisible url, good default for next `g' to browse url. + (let ((start (point))) + (insert url) + (put-text-property start (+ start (length url)) 'invisible t) + (setq xw (xwidget-insert + start 'webkit bufname + (xwidget-window-inside-pixel-width (selected-window)) + (xwidget-window-inside-pixel-height (selected-window))))) (xwidget-put xw 'callback callback) (xwidget-webkit-mode) (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url))) (defun xwidget-webkit-goto-url (url) - "Goto URL." + "Goto URL with xwidget webkit." (if (xwidget-webkit-current-session) (progn (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url)) (xwidget-webkit-new-session url))) (defun xwidget-webkit-back () - "Go back in history." + "Go back to previous URL in xwidget webkit buffer." + (interactive) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) -1)) + +(defun xwidget-webkit-forward () + "Go forward in history." (interactive) - (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "history.go(-1);")) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) 1)) (defun xwidget-webkit-reload () - "Reload current url." + "Reload current URL." (interactive) - (xwidget-webkit-execute-script (xwidget-webkit-current-session) - "history.go(0);")) + (xwidget-webkit-goto-history (xwidget-webkit-current-session) 0)) (defun xwidget-webkit-current-url () - "Get the webkit url and place it on the kill-ring." + "Display the current xwidget webkit URL and place it on the `kill-ring'." (interactive) - (xwidget-webkit-execute-script - (xwidget-webkit-current-session) - "document.URL" (lambda (rv) - (let ((url (kill-new (or rv "")))) - (message "url: %s" url))))) + (let ((url (xwidget-webkit-uri (xwidget-webkit-current-session)))) + (message "URL: %s" (kill-new (or url ""))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun xwidget-webkit-get-selection (proc) @@ -556,10 +626,9 @@ For example, use this to display an anchor." proc)) (defun xwidget-webkit-copy-selection-as-kill () - "Get the webkit selection and put it on the kill-ring." + "Get the webkit selection and put it on the `kill-ring'." (interactive) - (xwidget-webkit-get-selection (lambda (selection) (kill-new selection)))) - + (xwidget-webkit-get-selection #'kill-new)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Xwidget plist management (similar to the process plist functions) diff --git a/src/nsxwidget.h b/src/nsxwidget.h index 7e2a3e0c40..521601922f 100644 --- a/src/nsxwidget.h +++ b/src/nsxwidget.h @@ -32,7 +32,10 @@ along with GNU Emacs. If not, see . */ /* Functions for xwidget webkit. */ bool nsxwidget_is_web_view (struct xwidget *xw); +Lisp_Object nsxwidget_webkit_uri (struct xwidget *xw); +Lisp_Object nsxwidget_webkit_title (struct xwidget *xw); void nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri); +void nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos); void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change); void nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script, Lisp_Object fun); diff --git a/src/nsxwidget.m b/src/nsxwidget.m index c5376dd311..8643ba24d8 100644 --- a/src/nsxwidget.m +++ b/src/nsxwidget.m @@ -292,6 +292,21 @@ - (void)userContentController:(WKUserContentController *)userContentController return xw->xwWidget != NULL && [xw->xwWidget isKindOfClass:WKWebView.class]; } + +Lisp_Object +nsxwidget_webkit_uri (struct xwidget *xw) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + return build_string_with_nsstr (xwWebView.URL.absoluteString); +} + +Lisp_Object +nsxwidget_webkit_title (struct xwidget *xw) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + return build_string_with_nsstr (xwWebView.title); +} + /* @Note ATS - Need application transport security in 'Info.plist' or remote pages will not loaded. */ void @@ -304,6 +319,17 @@ - (void)userContentController:(WKUserContentController *)userContentController [xwWebView loadRequest:urlRequest]; } +void +nsxwidget_webkit_goto_history (struct xwidget *xw, int rel_pos) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + switch (rel_pos) { + case -1: [xwWebView goBack]; break; + case 0: [xwWebView reload]; break; + case 1: [xwWebView goForward]; break; + } +} + void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change) { diff --git a/src/xwidget.c b/src/xwidget.c index a3a3cd8d5b..d5c229c2b1 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -749,6 +749,36 @@ xwidget_is_web_view (struct xwidget *xw) return Qnil; \ } +DEFUN ("xwidget-webkit-uri", + Fxwidget_webkit_uri, Sxwidget_webkit_uri, + 1, 1, 0, + doc: /* Get the current URL of XWIDGET webkit. */) + (Lisp_Object xwidget) +{ + WEBKIT_FN_INIT (); +#ifdef USE_GTK + WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); + return build_string (webkit_web_view_get_uri (wkwv)); +#elif defined NS_IMPL_COCOA + return nsxwidget_webkit_uri (xw); +#endif +} + +DEFUN ("xwidget-webkit-title", + Fxwidget_webkit_title, Sxwidget_webkit_title, + 1, 1, 0, + doc: /* Get the current title of XWIDGET webkit. */) + (Lisp_Object xwidget) +{ + WEBKIT_FN_INIT (); +#ifdef USE_GTK + WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); + return build_string (webkit_web_view_get_title (wkwv)); +#elif defined NS_IMPL_COCOA + return nsxwidget_webkit_title (xw); +#endif +} + DEFUN ("xwidget-webkit-goto-uri", Fxwidget_webkit_goto_uri, Sxwidget_webkit_goto_uri, 2, 2, 0, @@ -766,6 +796,31 @@ DEFUN ("xwidget-webkit-goto-uri", return Qnil; } +DEFUN ("xwidget-webkit-goto-history", + Fxwidget_webkit_goto_history, Sxwidget_webkit_goto_history, + 2, 2, 0, + doc: /* Make the XWIDGET webkit load REL-POS (-1, 0, 1) page in browse history. */) + (Lisp_Object xwidget, Lisp_Object rel_pos) +{ + WEBKIT_FN_INIT (); + /* Should be one of -1, 0, 1 */ + if (XFIXNUM (rel_pos) < -1 || XFIXNUM (rel_pos) > 1) + args_out_of_range_3 (rel_pos, make_fixnum (-1), make_fixnum (1)); + +#ifdef USE_GTK + WebKitWebView *wkwv = WEBKIT_WEB_VIEW (xw->widget_osr); + switch (XFIXNAT (rel_pos)) + { + case -1: webkit_web_view_go_back (wkwv); break; + case 0: webkit_web_view_reload (wkwv); break; + case 1: webkit_web_view_go_forward (wkwv); break; + } +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_goto_history (xw, XFIXNAT (rel_pos)); +#endif + return Qnil; +} + DEFUN ("xwidget-webkit-zoom", Fxwidget_webkit_zoom, Sxwidget_webkit_zoom, 2, 2, 0, @@ -1106,7 +1161,10 @@ syms_of_xwidget (void) defsubr (&Sxwidget_query_on_exit_flag); defsubr (&Sset_xwidget_query_on_exit_flag); + defsubr (&Sxwidget_webkit_uri); + defsubr (&Sxwidget_webkit_title); defsubr (&Sxwidget_webkit_goto_uri); + defsubr (&Sxwidget_webkit_goto_history); defsubr (&Sxwidget_webkit_zoom); defsubr (&Sxwidget_webkit_execute_script); DEFSYM (Qwebkit, "webkit"); commit 433d8184970bd2d569744155d58cde2cd4807a0a Author: Glenn Morris Date: Wed Aug 12 11:29:51 2020 +0100 Tweak recent solar.el change * lisp/calendar/solar.el (sunrise-sunset, solar-equinoxes-solstices): Use +0000 for "numeric" UTC, not +0100. diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 85c3c481d3..05bb3164e1 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -841,7 +841,7 @@ This function is suitable for execution in an init file." (if (< arg 16) calendar-standard-time-zone-name (cond ((zerop calendar-time-zone) (if (eq calendar-time-zone-style 'numeric) - "+0100" "UTC")) + "+0000" "UTC")) ((< calendar-time-zone 0) (format "UTC%dmin" calendar-time-zone)) (t (format "UTC+%dmin" calendar-time-zone))))) @@ -1016,7 +1016,7 @@ Requires floating point." (calendar-standard-time-zone-name (cond (calendar-time-zone calendar-standard-time-zone-name) - ((eq calendar-time-zone-style 'numeric) "+0100") + ((eq calendar-time-zone-style 'numeric) "+0000") (t "UTC"))) (calendar-daylight-savings-starts (if calendar-time-zone calendar-daylight-savings-starts)) commit dca8b4ac5853767a1deb1947e72d038b4f4bb068 Author: Glenn Morris Date: Wed Aug 12 11:22:31 2020 +0100 Rename recent calendar user option * lisp/calendar/calendar.el (calendar-time-zone-style): Rename from calendar-use-numeric-time-zones. * lisp/calendar/cal-dst.el (calendar-standard-time-zone-name) (calendar-daylight-time-zone-name): * lisp/calendar/solar.el (sunrise-sunset, solar-equinoxes-solstices): Use new variable name. * doc/emacs/calendar.texi (Sunrise/Sunset): Update. ; * etc/NEWS: Update. diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi index 31db815df7..e5ee7e94bc 100644 --- a/doc/emacs/calendar.texi +++ b/doc/emacs/calendar.texi @@ -625,10 +625,9 @@ your time zone. Emacs displays the times of sunrise and sunset @emph{corrected for daylight saving time}. @xref{Daylight Saving}, for how daylight saving time is determined. -@vindex calendar-use-numeric-time-zones +@vindex calendar-time-zone-style If you want to display numerical time zones (like @samp{"+0100"}) -instead of symbolic time zones (like @samp{"CET"}), set the -@code{calendar-use-numeric-time-zones} variable to non-@code{nil}. +instead of symbolic ones (like @samp{"CET"}), set this to @code{numeric}. As a user, you might find it convenient to set the calendar location variables for your usual physical location in your @file{.emacs} file. diff --git a/etc/NEWS b/etc/NEWS index 39217897cc..5093336497 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -215,15 +215,14 @@ as a data list rather than as a piece of code. ** Calendar +++ -*** New variable 'calendar-use-numeric-time-zones' to use numeric time zones. -If non-nil, functions that display time zones (like the 'S' command in -calendar mode that displays the sunrise time) will display time zones -like "+0100" instead of "CET". +*** New user option 'calendar-time-zone-style'. +If 'numeric, calendar functions (eg calendar-sunrise-sunset) that display +time zones will use a form like "+0100" instead of "CET". ** Dired +++ -*** New used option 'dired-copy-dereference'. +*** New user option 'dired-copy-dereference'. If set, Dired will dereferences symbolic links when copying. This can be switched off on a per-usage basis by providing 'dired-do-copy' with a 'C-u' prefix. diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index af6acaf09a..05768e10c0 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -350,7 +350,7 @@ If the locale never uses daylight saving time, set this to 0." :group 'calendar-dst) (defcustom calendar-standard-time-zone-name - (if calendar-use-numeric-time-zones + (if (eq calendar-time-zone-style 'numeric) (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (car calendar-current-time-zone-cache))) @@ -360,10 +360,11 @@ If the locale never uses daylight saving time, set this to 0." For example, \"EST\" in New York City, \"PST\" for Los Angeles." :type 'string :version "28.1" + :set-after '(calendar-time-zone-style) :group 'calendar-dst) (defcustom calendar-daylight-time-zone-name - (if calendar-use-numeric-time-zones + (if (eq calendar-time-zone-style 'numeric) (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) @@ -373,6 +374,7 @@ For example, \"EST\" in New York City, \"PST\" for Los Angeles." For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." :type 'string :version "28.1" + :set-after '(calendar-time-zone-style) :group 'calendar-dst) (defcustom calendar-daylight-savings-starts-time diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0efb2bc660..574261456f 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1061,10 +1061,12 @@ calendar." :type 'boolean :group 'holidays) -(defcustom calendar-use-numeric-time-zones nil - "If nil, use symbolic time zones like \"CET\" when displaying dates. -If non-nil, use numeric time zones like \"+0100\"." - :type 'boolean +;; fixme should have a :set that changes calendar-standard-time-zone-name etc. +(defcustom calendar-time-zone-style 'symbolic + "Your preferred style for time zones. +If 'numeric, use numeric time zones like \"+0100\". +Otherwise, use symbolic time zones like \"CET\"." + :type '(choice (const numeric) (other symbolic)) :version "28.1" :group 'calendar) diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 635bdd8f11..85c3c481d3 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -840,7 +840,7 @@ This function is suitable for execution in an init file." (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name (cond ((zerop calendar-time-zone) - (if calendar-use-numeric-time-zones + (if (eq calendar-time-zone-style 'numeric) "+0100" "UTC")) ((< calendar-time-zone 0) (format "UTC%dmin" calendar-time-zone)) @@ -1016,7 +1016,7 @@ Requires floating point." (calendar-standard-time-zone-name (cond (calendar-time-zone calendar-standard-time-zone-name) - (calendar-use-numeric-time-zones "+0100") + ((eq calendar-time-zone-style 'numeric) "+0100") (t "UTC"))) (calendar-daylight-savings-starts (if calendar-time-zone calendar-daylight-savings-starts)) commit d089c4fbfc8be432dc3015a99b4044dab0a0de97 Author: Sungbin Jo Date: Wed Aug 12 12:12:34 2020 +0200 Add xwidget support for macOS Co-authored-by: Jaesup Kwak * configure.ac: Allow '--with-xwidgets' for "${NS_IMPL_COCOA}". * etc/NEWS: Mention new feature. * etc/TODO: Remove done TODO to implement xwidget in NeXTstep port. * lisp/xwidget.el (xwidget-webkit-clone-and-split-below) (xwidget-webkit-clone-and-split-right): New procedures. (xwidget-webkit-callback): Remove call to 'xwidget-webkit-adjust-size-to-window' as adjusting xwidget size is handled in 'x_draw_xwidget_glyph_string'. (xwidget-webkit-enable-plugins): New variable. * nextstep/templates/Info.plist.in: Add 'NSAppTransportSecurity'. * src/Makefile.in: Add nsxwidget.o for compilation. * src/emacs.c (main): Move conditional call to 'syms_of_xwidget'. * src/nsterm.m (ns_draw_glyph_string): Add case for 'XWIDGET_GLYPH'. (note_mouse_movement mouseMoved): Make it easy to resize window by dragging mode-line or vertical separator adjacent to large glyph. * src/nsxwidget.h src/nsxwidget.m: Newly added files, xwidget webkit backend for macOS Cocoa. * src/xwidget.c (Fmake_xwidget, xwidget_init_view) (x_draw_xwidget_glyph_string, xwidget_is_web_view) (Fxwidget_webkit_goto_uri, Fxwidget_webkit_zoom, Fxwidget_resize) (Fxwidget_size_request, Fdelete_xwidget_view, xwidget_end_redisplay) (kill_buffer_xwidgets): Add macOS Cocoa specific functions and code with 'NS_IMPL_COCOA' and guard GTK specific functions and code with 'USE_GTK'. (x_draw_xwidget_glyph_string): Handle adjusting xwidget size. * src/xwidget.h (xwidget, xwidget_view): Add macOS Cocoa specific fields with 'NS_IMPL_COCOA' and guard GTK specific fields with USE_GTK. diff --git a/configure.ac b/configure.ac index c9aa076eb3..7ce64f79ca 100644 --- a/configure.ac +++ b/configure.ac @@ -489,7 +489,7 @@ otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.]) [with_file_notification=$with_features]) OPTION_DEFAULT_OFF([xwidgets], - [enable use of some gtk widgets in Emacs buffers (requires gtk3)]) + [enable use of xwidgets in Emacs buffers (requires gtk3 or macOS Cocoa)]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -2754,20 +2754,34 @@ fi dnl Enable xwidgets if GTK3 and WebKitGTK+ are available. +dnl Enable xwidgets if macOS Cocoa and WebKit framework are available. HAVE_XWIDGETS=no XWIDGETS_OBJ= if test "$with_xwidgets" != "no"; then - test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none" || - AC_MSG_ERROR([xwidgets requested but gtk3 not used.]) + if test "$USE_GTK_TOOLKIT" = "GTK3" && test "$window_system" != "none"; then + WEBKIT_REQUIRED=2.12 + WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED" + EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES]) + HAVE_XWIDGETS=$HAVE_WEBKIT + XWIDGETS_OBJ="xwidget.o" + elif test "${NS_IMPL_COCOA}" = "yes"; then + dnl FIXME: Check framework WebKit2 + dnl WEBKIT_REQUIRED=M.m.p + WEBKIT_LIBS="-Wl,-framework -Wl,WebKit" + WEBKIT_CFLAGS="-I/System/Library/Frameworks/WebKit.framework/Headers" + HAVE_WEBKIT="yes" + HAVE_XWIDGETS=$HAVE_WEBKIT + XWIDGETS_OBJ="xwidget.o" + NS_OBJC_OBJ="$NS_OBJC_OBJ nsxwidget.o" + dnl Update NS_OBJC_OBJ with added nsxwidget.o + AC_SUBST(NS_OBJC_OBJ) + else + AC_MSG_ERROR([xwidgets requested, it requires GTK3 as X window toolkit or macOS Cocoa as window system.]) + fi - WEBKIT_REQUIRED=2.12 - WEBKIT_MODULES="webkit2gtk-4.0 >= $WEBKIT_REQUIRED" - EMACS_CHECK_MODULES([WEBKIT], [$WEBKIT_MODULES]) - HAVE_XWIDGETS=$HAVE_WEBKIT test $HAVE_XWIDGETS = yes || - AC_MSG_ERROR([xwidgets requested but WebKitGTK+ not found.]) + AC_MSG_ERROR([xwidgets requested but WebKitGTK+ or WebKit framework not found.]) - XWIDGETS_OBJ=xwidget.o AC_DEFINE([HAVE_XWIDGETS], 1, [Define to 1 if you have xwidgets support.]) fi AC_SUBST(XWIDGETS_OBJ) @@ -5688,7 +5702,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs directly use zlib? ${HAVE_ZLIB} Does Emacs have dynamic modules support? ${HAVE_MODULES} Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS} - Does Emacs support Xwidgets (requires gtk3)? ${HAVE_XWIDGETS} + Does Emacs support Xwidgets? ${HAVE_XWIDGETS} Does Emacs have threading support in lisp? ${threads_enabled} Does Emacs support the portable dumper? ${with_pdumper} Does Emacs support legacy unexec dumping? ${with_unexec} diff --git a/etc/NEWS b/etc/NEWS index 5c44c970dd..39217897cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -958,6 +958,18 @@ convert them to a list '(R G B)' of primary color values. * Changes in Emacs 28.1 on Non-Free Operating Systems +--- +** On macOS, Xwidget is now supported. +If Emacs was built with xwidget support, you can access the embedded +webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two +instances of xwidget webkit is not supported. + +*** New functions for xwidget-webkit mode +'xwidget-webkit-clone-and-split-below', +'xwidget-webkit-clone-and-split-right'. + +*** New variable 'xwidget-webkit-enable-plugins'. + +++ ** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. 'module-file-suffix' now has the value ".dylib" on macOS, but the @@ -998,6 +1010,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . + Local variables: coding: utf-8 diff --git a/lisp/xwidget.el b/lisp/xwidget.el index a4c15a1e26..f0940a9203 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -99,6 +99,24 @@ Interactively, URL defaults to the string looking like a url around point." (xwidget-webkit-new-session url) (xwidget-webkit-goto-url url)))) +(defun xwidget-webkit-clone-and-split-below () + "Clone current URL into a new widget place in new window below. +Get the URL of current session, then browse to the URL +in `split-window-below' with a new xwidget webkit session." + (interactive) + (let ((url (xwidget-webkit-current-url))) + (with-selected-window (split-window-below) + (xwidget-webkit-new-session url)))) + +(defun xwidget-webkit-clone-and-split-right () + "Clone current URL into a new widget place in new window right. +Get the URL of current session, then browse to the URL +in `split-window-right' with a new xwidget webkit session." + (interactive) + (let ((url (xwidget-webkit-current-url))) + (with-selected-window (split-window-right) + (xwidget-webkit-new-session url)))) + ;;todo. ;; - check that the webkit support is compiled in (defvar xwidget-webkit-mode-map @@ -222,9 +240,9 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." xwidget "document.title" (lambda (title) (xwidget-log "webkit finished loading: '%s'" title) - ;;TODO - check the native/internal scroll - ;;(xwidget-adjust-size-to-content xwidget) - (xwidget-webkit-adjust-size-to-window xwidget) + ;; Do not adjust webkit size to window here, the + ;; selected window can be the mini-buffer window + ;; unwantedly. (rename-buffer (format "*xwidget webkit: %s *" title)))) (pop-to-buffer (current-buffer))) ((eq xwidget-event-type 'decide-policy) @@ -240,6 +258,11 @@ XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget." (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))) (defvar bookmark-make-record-function) +(when (memq window-system '(mac ns)) + (defvar xwidget-webkit-enable-plugins nil + "Enable plugins for xwidget webkit. +If non-nil, plugins are enabled. Otherwise, disabled.")) + (define-derived-mode xwidget-webkit-mode special-mode "xwidget-webkit" "Xwidget webkit view mode." (setq buffer-read-only t) diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in index f791ade7b9..1f074b0457 100644 --- a/nextstep/templates/Info.plist.in +++ b/nextstep/templates/Info.plist.in @@ -675,8 +675,16 @@ along with GNU Emacs. If not, see . NSAppleScriptEnabled YES - NSAppleEventsUsageDescription - Emacs requires permission to send AppleEvents to other applications. + NSAppleEventsUsageDescription + Emacs requires permission to send AppleEvents to other applications. + + NSAppTransportSecurity + + NSAllowsArbitraryLoads + + NSDesktopFolderUsageDescription Emacs requires permission to access the Desktop folder. NSDocumentsFolderUsageDescription diff --git a/src/Makefile.in b/src/Makefile.in index 7141f16ec2..c5fb2ea3ab 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -433,6 +433,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \ fontset.o dbusbind.o cygw32.o \ nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \ + nsxwidget.o \ w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \ diff --git a/src/emacs.c b/src/emacs.c index d31fa2cb28..cb04de4aab 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1860,7 +1860,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_xfns (); syms_of_xmenu (); syms_of_fontset (); - syms_of_xwidget (); syms_of_xsettings (); #ifdef HAVE_X_SM syms_of_xsmfns (); @@ -1937,6 +1936,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif /* HAVE_W32NOTIFY */ #endif /* WINDOWSNT */ + syms_of_xwidget (); syms_of_threads (); syms_of_profiler (); syms_of_pdumper (); diff --git a/src/nsterm.m b/src/nsterm.m index 572b859a98..9f5916d78e 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -49,6 +49,7 @@ Updated by Christian Limpach (chris@nice.ch) #include "nsterm.h" #include "systime.h" #include "character.h" +#include "xwidget.h" #include "fontset.h" #include "composite.h" #include "ccl.h" @@ -2600,7 +2601,8 @@ so some key presses (TAB) are swallowed by the system. */ } static int -ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y) +ns_note_mouse_movement (struct frame *frame, CGFloat x, CGFloat y, + BOOL dragging) /* ------------------------------------------------------------------------ Called by EmacsView on mouseMovement events. Passes on to emacs mainstream code if we moved off of a rect of interest @@ -2609,17 +2611,24 @@ so some key presses (TAB) are swallowed by the system. */ { struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); NSRect *r; + BOOL force_update = NO; // NSTRACE ("note_mouse_movement"); dpyinfo->last_mouse_motion_frame = frame; r = &dpyinfo->last_mouse_glyph; + /* If the last rect is too large (ex, xwidget webkit), update at + every move, or resizing by dragging modeline or vertical split is + very hard to make its way. */ + if (dragging && (r->size.width > 32 || r->size.height > 32)) + force_update = YES; + /* Note, this doesn't get called for enter/leave, since we don't have a position. Those are taken care of in the corresponding NSView methods. */ /* Has movement gone beyond last rect we were tracking? */ - if (x < r->origin.x || x >= r->origin.x + r->size.width + if (force_update || x < r->origin.x || x >= r->origin.x + r->size.width || y < r->origin.y || y >= r->origin.y + r->size.height) { ns_update_begin (frame); @@ -4368,6 +4377,10 @@ overwriting cursor (usually when cursor on a tab) */ ns_unfocus (s->f); break; + case XWIDGET_GLYPH: + x_draw_xwidget_glyph_string (s); + break; + case STRETCH_GLYPH: ns_dumpglyphs_stretch (s); break; @@ -7065,6 +7078,7 @@ - (void)mouseMoved: (NSEvent *)e struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); Lisp_Object frame; NSPoint pt; + BOOL dragging; NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]"); @@ -7107,7 +7121,8 @@ - (void)mouseMoved: (NSEvent *)e last_mouse_window = window; } - if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y)) + dragging = (e.type == NSEventTypeLeftMouseDragged); + if (!ns_note_mouse_movement (emacsframe, pt.x, pt.y, dragging)) help_echo_string = previous_help_echo_string; XSETFRAME (frame, emacsframe); diff --git a/src/nsxwidget.h b/src/nsxwidget.h new file mode 100644 index 0000000000..7e2a3e0c40 --- /dev/null +++ b/src/nsxwidget.h @@ -0,0 +1,77 @@ +/* Header for NS Cocoa part of xwidget and webkit widget. + +Copyright (C) 2019 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef NSXWIDGET_H_INCLUDED +#define NSXWIDGET_H_INCLUDED + +/* This file can be included from non-objc files through 'xwidget.h'. */ +#ifdef __OBJC__ +#import +#endif + +#include "dispextern.h" +#include "lisp.h" +#include "xwidget.h" + +/* Functions for xwidget webkit. */ + +bool nsxwidget_is_web_view (struct xwidget *xw); +void nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri); +void nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change); +void nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script, + Lisp_Object fun); + +/* Functions for xwidget model. */ + +#ifdef __OBJC__ +@interface XwWindow : NSView +@property struct xwidget *xw; +@end +#endif + +void nsxwidget_init (struct xwidget *xw); +void nsxwidget_kill (struct xwidget *xw); +void nsxwidget_resize (struct xwidget *xw); +Lisp_Object nsxwidget_get_size (struct xwidget *xw); + +/* Functions for xwidget view. */ + +#ifdef __OBJC__ +@interface XvWindow : NSView +@property struct xwidget *xw; +@property struct xwidget_view *xv; +@end +#endif + +void nsxwidget_init_view (struct xwidget_view *xv, + struct xwidget *xww, + struct glyph_string *s, + int x, int y); +void nsxwidget_delete_view (struct xwidget_view *xv); + +void nsxwidget_show_view (struct xwidget_view *xv); +void nsxwidget_hide_view (struct xwidget_view *xv); +void nsxwidget_resize_view (struct xwidget_view *xv, + int widget, int height); + +void nsxwidget_move_view (struct xwidget_view *xv, int x, int y); +void nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y); +void nsxwidget_set_needsdisplay (struct xwidget_view *xv); + +#endif /* NSXWIDGET_H_INCLUDED */ diff --git a/src/nsxwidget.m b/src/nsxwidget.m new file mode 100644 index 0000000000..c5376dd311 --- /dev/null +++ b/src/nsxwidget.m @@ -0,0 +1,563 @@ +/* NS Cocoa part implementation of xwidget and webkit widget. + +Copyright (C) 2019 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#include + +#include "lisp.h" +#include "blockinput.h" +#include "dispextern.h" +#include "buffer.h" +#include "frame.h" +#include "nsterm.h" +#include "xwidget.h" + +#import +#import + +/* Thoughts on NS Cocoa xwidget and webkit2: + + Webkit2 process architecture seems to be very hostile for offscreen + rendering techniques, which is used by GTK xwiget implementation; + Specifically NSView level view sharing / copying is not working. + + *** So only one view can be associcated with a model. *** + + With this decision, implementation is plain and can expect best out + of webkit2's rationale. But process and session structures will + diverge from GTK xwiget. Though, cosmetically similar usages can + be presented and will be preferred, if agreeable. + + For other widget types, OSR seems possible, but will not care for a + while. */ + +/* Xwidget webkit. */ + +@interface XwWebView : WKWebView + +@property struct xwidget *xw; +/* Map url to whether javascript is blocked by + 'Content-Security-Policy' sandbox without allow-scripts. */ +@property(retain) NSMutableDictionary *urlScriptBlocked; +@end +@implementation XwWebView : WKWebView + +- (id)initWithFrame:(CGRect)frame + configuration:(WKWebViewConfiguration *)configuration + xwidget:(struct xwidget *)xw +{ + /* Script controller to add script message handler and user script. */ + WKUserContentController *scriptor = [[WKUserContentController alloc] init]; + configuration.userContentController = scriptor; + + /* Enable inspect element context menu item for debugging. */ + [configuration.preferences setValue:@YES + forKey:@"developerExtrasEnabled"]; + + Lisp_Object enablePlugins = + Fintern (build_string ("xwidget-webkit-enable-plugins"), Qnil); + if (!EQ (Fsymbol_value (enablePlugins), Qnil)) + configuration.preferences.plugInsEnabled = YES; + + self = [super initWithFrame:frame configuration:configuration]; + if (self) + { + self.xw = xw; + self.urlScriptBlocked = [[NSMutableDictionary alloc] init]; + self.navigationDelegate = self; + self.UIDelegate = self; + self.customUserAgent = + @"Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6)" + @" AppleWebKit/603.3.8 (KHTML, like Gecko)" + @" Version/11.0.1 Safari/603.3.8"; + [scriptor addScriptMessageHandler:self name:@"keyDown"]; + [scriptor addUserScript:[[WKUserScript alloc] + initWithSource:xwScript + injectionTime: + WKUserScriptInjectionTimeAtDocumentStart + forMainFrameOnly:NO]]; + } + return self; +} + +- (void)webView:(WKWebView *)webView +didFinishNavigation:(WKNavigation *)navigation +{ + if (EQ (Fbuffer_live_p (self.xw->buffer), Qt)) + store_xwidget_event_string (self.xw, "load-changed", ""); +} + +- (void)webView:(WKWebView *)webView +decidePolicyForNavigationAction:(WKNavigationAction *)navigationAction +decisionHandler:(void (^)(WKNavigationActionPolicy))decisionHandler +{ + switch (navigationAction.navigationType) { + case WKNavigationTypeLinkActivated: + decisionHandler (WKNavigationActionPolicyAllow); + break; + default: + // decisionHandler (WKNavigationActionPolicyCancel); + decisionHandler (WKNavigationActionPolicyAllow); + break; + } +} + +- (void)webView:(WKWebView *)webView +decidePolicyForNavigationResponse:(WKNavigationResponse *)navigationResponse +decisionHandler:(void (^)(WKNavigationResponsePolicy))decisionHandler +{ + decisionHandler (WKNavigationResponsePolicyAllow); + + self.urlScriptBlocked[navigationResponse.response.URL] = + [NSNumber numberWithBool:NO]; + if ([navigationResponse.response isKindOfClass:[NSHTTPURLResponse class]]) + { + NSDictionary *headers = + ((NSHTTPURLResponse *) navigationResponse.response).allHeaderFields; + NSString *value = headers[@"Content-Security-Policy"]; + if (value) + { + /* TODO: Sloppy parsing of 'Content-Security-Policy' value. */ + NSRange sandbox = [value rangeOfString:@"sandbox"]; + if (sandbox.location != NSNotFound + && (sandbox.location == 0 + || [value characterAtIndex:(sandbox.location - 1)] == ' ' + || [value characterAtIndex:(sandbox.location - 1)] == ';')) + { + NSRange allowScripts = [value rangeOfString:@"allow-scripts"]; + if (allowScripts.location == NSNotFound + || allowScripts.location < sandbox.location) + self.urlScriptBlocked[navigationResponse.response.URL] = + [NSNumber numberWithBool:YES]; + } + } + } +} + +/* No additional new webview or emacs window will be created + for . */ +- (WKWebView *)webView:(WKWebView *)webView +createWebViewWithConfiguration:(WKWebViewConfiguration *)configuration + forNavigationAction:(WKNavigationAction *)navigationAction + windowFeatures:(WKWindowFeatures *)windowFeatures +{ + if (!navigationAction.targetFrame.isMainFrame) + [webView loadRequest:navigationAction.request]; + return nil; +} + +/* Open panel for file upload. */ +- (void)webView:(WKWebView *)webView +runOpenPanelWithParameters:(WKOpenPanelParameters *)parameters +initiatedByFrame:(WKFrameInfo *)frame +completionHandler:(void (^)(NSArray *URLs))completionHandler +{ + NSOpenPanel *openPanel = [NSOpenPanel openPanel]; + openPanel.canChooseFiles = YES; + openPanel.canChooseDirectories = NO; + openPanel.allowsMultipleSelection = parameters.allowsMultipleSelection; + if ([openPanel runModal] == NSModalResponseOK) + completionHandler (openPanel.URLs); + else + completionHandler (nil); +} + +/* By forwarding mouse events to emacs view (frame) + - Mouse click in webview selects the window contains the webview. + - Correct mouse hand/arrow/I-beam is displayed (TODO: not perfect yet). +*/ + +- (void)mouseDown:(NSEvent *)event +{ + [self.xw->xv->emacswindow mouseDown:event]; + [super mouseDown:event]; +} + +- (void)mouseUp:(NSEvent *)event +{ + [self.xw->xv->emacswindow mouseUp:event]; + [super mouseUp:event]; +} + +/* Basically we want keyboard events handled by emacs unless an input + element has focus. Especially, while incremental search, we set + emacs as first responder to avoid focus held in an input element + with matching text. */ + +- (void)keyDown:(NSEvent *)event +{ + Lisp_Object var = Fintern (build_string ("isearch-mode"), Qnil); + Lisp_Object val = buffer_local_value (var, Fcurrent_buffer ()); + if (!EQ (val, Qunbound) && !EQ (val, Qnil)) + { + [self.window makeFirstResponder:self.xw->xv->emacswindow]; + [self.xw->xv->emacswindow keyDown:event]; + return; + } + + /* Emacs handles keyboard events when javascript is blocked. */ + if ([self.urlScriptBlocked[self.URL] boolValue]) + { + [self.xw->xv->emacswindow keyDown:event]; + return; + } + + [self evaluateJavaScript:@"xwHasFocus()" + completionHandler:^(id result, NSError *error) { + if (error) + { + NSLog (@"xwHasFocus: %@", error); + [self.xw->xv->emacswindow keyDown:event]; + } + else if (result) + { + NSNumber *hasFocus = result; /* __NSCFBoolean */ + if (!hasFocus.boolValue) + [self.xw->xv->emacswindow keyDown:event]; + else + [super keyDown:event]; + } + }]; +} + +- (void)interpretKeyEvents:(NSArray *)eventArray +{ + /* We should do nothing and do not forward (default implementation + if we not override here) to let emacs collect key events and ask + interpretKeyEvents to its superclass. */ +} + +static NSString *xwScript; ++ (void)initialize +{ + /* Find out if an input element has focus. + Message to script message handler when 'C-g' key down. */ + if (!xwScript) + xwScript = + @"function xwHasFocus() {" + @" var ae = document.activeElement;" + @" if (ae) {" + @" var name = ae.nodeName;" + @" return name == 'INPUT' || name == 'TEXTAREA';" + @" } else {" + @" return false;" + @" }" + @"}" + @"function xwKeyDown(event) {" + @" if (event.ctrlKey && event.key == 'g') {" + @" window.webkit.messageHandlers.keyDown.postMessage('C-g');" + @" }" + @"}" + @"document.addEventListener('keydown', xwKeyDown);" + ; +} + +/* Confirming to WKScriptMessageHandler, listens concerning keyDown in + webkit. Currently 'C-g'. */ +- (void)userContentController:(WKUserContentController *)userContentController + didReceiveScriptMessage:(WKScriptMessage *)message +{ + if ([message.body isEqualToString:@"C-g"]) + { + /* Just give up focus, no relay "C-g" to emacs, another "C-g" + follows will be handled by emacs. */ + [self.window makeFirstResponder:self.xw->xv->emacswindow]; + } +} + +@end + +/* Xwidget webkit commands. */ + +static Lisp_Object build_string_with_nsstr (NSString *nsstr); + +bool +nsxwidget_is_web_view (struct xwidget *xw) +{ + return xw->xwWidget != NULL && + [xw->xwWidget isKindOfClass:WKWebView.class]; +} +/* @Note ATS - Need application transport security in 'Info.plist' or + remote pages will not loaded. */ +void +nsxwidget_webkit_goto_uri (struct xwidget *xw, const char *uri) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + NSString *urlString = [NSString stringWithUTF8String:uri]; + NSURL *url = [NSURL URLWithString:urlString]; + NSURLRequest *urlRequest = [NSURLRequest requestWithURL:url]; + [xwWebView loadRequest:urlRequest]; +} + +void +nsxwidget_webkit_zoom (struct xwidget *xw, double zoom_change) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + xwWebView.magnification += zoom_change; + /* TODO: setMagnification:centeredAtPoint. */ +} + +/* Build lisp string */ +static Lisp_Object +build_string_with_nsstr (NSString *nsstr) +{ + const char *utfstr = [nsstr UTF8String]; + NSUInteger bytes = [nsstr lengthOfBytesUsingEncoding:NSUTF8StringEncoding]; + return make_string (utfstr, bytes); +} + +/* Recursively convert an objc native type JavaScript value to a Lisp + value. Mostly copied from GTK xwidget 'webkit_js_to_lisp'. */ +static Lisp_Object +js_to_lisp (id value) +{ + if (value == nil || [value isKindOfClass:NSNull.class]) + return Qnil; + else if ([value isKindOfClass:NSString.class]) + return build_string_with_nsstr ((NSString *) value); + else if ([value isKindOfClass:NSNumber.class]) + { + NSNumber *nsnum = (NSNumber *) value; + char type = nsnum.objCType[0]; + if (type == 'c') /* __NSCFBoolean has type character 'c'. */ + return nsnum.boolValue? Qt : Qnil; + else + { + if (type == 'i' || type == 'l') + return make_int (nsnum.longValue); + else if (type == 'f' || type == 'd') + return make_float (nsnum.doubleValue); + /* else fall through. */ + } + } + else if ([value isKindOfClass:NSArray.class]) + { + NSArray *nsarr = (NSArray *) value; + EMACS_INT n = nsarr.count; + Lisp_Object obj; + struct Lisp_Vector *p = allocate_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]); + XSETVECTOR (obj, p); + return obj; + } + else if ([value isKindOfClass:NSDictionary.class]) + { + NSDictionary *nsdict = (NSDictionary *) value; + NSArray *keys = nsdict.allKeys; + ptrdiff_t n = keys.count; + Lisp_Object obj; + struct Lisp_Vector *p = allocate_vector (n); + + for (ptrdiff_t i = 0; i < n; ++i) + { + NSString *prop_key = (NSString *) [keys objectAtIndex:i]; + id prop_value = [nsdict valueForKey:prop_key]; + p->contents[i] = Fcons (build_string_with_nsstr (prop_key), + js_to_lisp (prop_value)); + } + XSETVECTOR (obj, p); + return obj; + } + NSLog (@"Unhandled type in javascript result"); + return Qnil; +} + +void +nsxwidget_webkit_execute_script (struct xwidget *xw, const char *script, + Lisp_Object fun) +{ + XwWebView *xwWebView = (XwWebView *) xw->xwWidget; + if ([xwWebView.urlScriptBlocked[xwWebView.URL] boolValue]) + { + message ("Javascript is blocked by 'CSP: sandbox'."); + return; + } + + NSString *javascriptString = [NSString stringWithUTF8String:script]; + [xwWebView evaluateJavaScript:javascriptString + completionHandler:^(id result, NSError *error) { + if (error) + { + NSLog (@"evaluateJavaScript error : %@", error.localizedDescription); + NSLog (@"error script=%@", javascriptString); + } + else if (result && FUNCTIONP (fun)) + { + // NSLog (@"result=%@, type=%@", result, [result class]); + Lisp_Object lisp_value = js_to_lisp (result); + store_xwidget_js_callback_event (xw, fun, lisp_value); + } + }]; +} + +/* Window containing an xwidget. */ + +@implementation XwWindow +- (BOOL)isFlipped { return YES; } +@end + +/* Xwidget model, macOS Cocoa part. */ + +void +nsxwidget_init(struct xwidget *xw) +{ + block_input (); + NSRect rect = NSMakeRect (0, 0, xw->width, xw->height); + xw->xwWidget = [[XwWebView alloc] + initWithFrame:rect + configuration:[[WKWebViewConfiguration alloc] init] + xwidget:xw]; + xw->xwWindow = [[XwWindow alloc] + initWithFrame:rect]; + [xw->xwWindow addSubview:xw->xwWidget]; + xw->xv = NULL; /* for 1 to 1 relationship of webkit2. */ + unblock_input (); +} + +void +nsxwidget_kill (struct xwidget *xw) +{ + if (xw) + { + WKUserContentController *scriptor = + ((XwWebView *) xw->xwWidget).configuration.userContentController; + [scriptor removeAllUserScripts]; + [scriptor removeScriptMessageHandlerForName:@"keyDown"]; + [scriptor release]; + if (xw->xv) + xw->xv->model = Qnil; /* Make sure related view stale. */ + + /* This stops playing audio when a xwidget-webkit buffer is + killed. I could not find other solution. */ + nsxwidget_webkit_goto_uri (xw, "about:blank"); + + [((XwWebView *) xw->xwWidget).urlScriptBlocked release]; + [xw->xwWidget removeFromSuperviewWithoutNeedingDisplay]; + [xw->xwWidget release]; + [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay]; + [xw->xwWindow release]; + xw->xwWidget = nil; + } +} + +void +nsxwidget_resize (struct xwidget *xw) +{ + if (xw->xwWidget) + { + [xw->xwWindow setFrameSize:NSMakeSize(xw->width, xw->height)]; + [xw->xwWidget setFrameSize:NSMakeSize(xw->width, xw->height)]; + } +} + +Lisp_Object +nsxwidget_get_size (struct xwidget *xw) +{ + return list2i (xw->xwWidget.frame.size.width, + xw->xwWidget.frame.size.height); +} + +/* Xwidget view, macOS Cocoa part. */ + +@implementation XvWindow : NSView +- (BOOL)isFlipped { return YES; } +@end + +void +nsxwidget_init_view (struct xwidget_view *xv, + struct xwidget *xw, + struct glyph_string *s, + int x, int y) +{ + /* 'x_draw_xwidget_glyph_string' will calculate correct position and + size of clip to draw in emacs buffer window. Thus, just begin at + origin with no crop. */ + xv->x = x; + xv->y = y; + xv->clip_left = 0; + xv->clip_right = xw->width; + xv->clip_top = 0; + xv->clip_bottom = xw->height; + + xv->xvWindow = [[XvWindow alloc] + initWithFrame:NSMakeRect (x, y, xw->width, xw->height)]; + xv->xvWindow.xw = xw; + xv->xvWindow.xv = xv; + + xw->xv = xv; /* For 1 to 1 relationship of webkit2. */ + [xv->xvWindow addSubview:xw->xwWindow]; + + xv->emacswindow = FRAME_NS_VIEW (s->f); + [xv->emacswindow addSubview:xv->xvWindow]; +} + +void +nsxwidget_delete_view (struct xwidget_view *xv) +{ + if (!EQ (xv->model, Qnil)) + { + struct xwidget *xw = XXWIDGET (xv->model); + [xw->xwWindow removeFromSuperviewWithoutNeedingDisplay]; + xw->xv = NULL; /* Now model has no view. */ + } + [xv->xvWindow removeFromSuperviewWithoutNeedingDisplay]; + [xv->xvWindow release]; +} + +void +nsxwidget_show_view (struct xwidget_view *xv) +{ + xv->hidden = NO; + [xv->xvWindow setFrameOrigin:NSMakePoint(xv->x + xv->clip_left, + xv->y + xv->clip_top)]; +} + +void +nsxwidget_hide_view (struct xwidget_view *xv) +{ + xv->hidden = YES; + [xv->xvWindow setFrameOrigin:NSMakePoint(10000, 10000)]; +} + +void +nsxwidget_resize_view (struct xwidget_view *xv, int width, int height) +{ + [xv->xvWindow setFrameSize:NSMakeSize(width, height)]; +} + +void +nsxwidget_move_view (struct xwidget_view *xv, int x, int y) +{ + [xv->xvWindow setFrameOrigin:NSMakePoint (x, y)]; +} + +/* Move model window in container (view window). */ +void +nsxwidget_move_widget_in_view (struct xwidget_view *xv, int x, int y) +{ + struct xwidget *xww = xv->xvWindow.xw; + [xww->xwWindow setFrameOrigin:NSMakePoint (x, y)]; +} + +void +nsxwidget_set_needsdisplay (struct xwidget_view *xv) +{ + xv->xvWindow.needsDisplay = YES; +} diff --git a/src/xwidget.c b/src/xwidget.c index 0347f1e648..a3a3cd8d5b 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -23,13 +23,21 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "blockinput.h" +#include "dispextern.h" #include "frame.h" #include "keyboard.h" #include "gtkutil.h" #include "sysstdio.h" +#include "termhooks.h" +#include "window.h" +/* Include xwidget bottom end headers. */ +#ifdef USE_GTK #include #include +#elif defined NS_IMPL_COCOA +#include "nsxwidget.h" +#endif static struct xwidget * allocate_xwidget (void) @@ -48,6 +56,7 @@ allocate_xwidget_view (void) static struct xwidget_view *xwidget_view_lookup (struct xwidget *, struct window *); +#ifdef USE_GTK static void webkit_view_load_changed_cb (WebKitWebView *, WebKitLoadEvent, gpointer); @@ -61,6 +70,7 @@ webkit_decide_policy_cb (WebKitWebView *, WebKitPolicyDecision *, WebKitPolicyDecisionType, gpointer); +#endif DEFUN ("make-xwidget", @@ -78,8 +88,10 @@ Returns the newly constructed xwidget, or nil if construction fails. */) Lisp_Object title, Lisp_Object width, Lisp_Object height, Lisp_Object arguments, Lisp_Object buffer) { +#ifdef USE_GTK if (!xg_gtk_initialized) error ("make-xwidget: GTK has not been initialized"); +#endif CHECK_SYMBOL (type); CHECK_FIXNAT (width); CHECK_FIXNAT (height); @@ -94,10 +106,11 @@ Returns the newly constructed xwidget, or nil if construction fails. */) xw->kill_without_query = false; XSETXWIDGET (val, xw); Vxwidget_list = Fcons (val, Vxwidget_list); - xw->widgetwindow_osr = NULL; - xw->widget_osr = NULL; xw->plist = Qnil; +#ifdef USE_GTK + xw->widgetwindow_osr = NULL; + xw->widget_osr = NULL; if (EQ (xw->type, Qwebkit)) { block_input (); @@ -152,6 +165,9 @@ Returns the newly constructed xwidget, or nil if construction fails. */) unblock_input (); } +#elif defined NS_IMPL_COCOA + nsxwidget_init (xw); +#endif return val; } @@ -187,6 +203,7 @@ xwidget_hidden (struct xwidget_view *xv) return xv->hidden; } +#ifdef USE_GTK static void xwidget_show_view (struct xwidget_view *xv) { @@ -220,13 +237,14 @@ offscreen_damage_event (GtkWidget *widget, GdkEvent *event, if (GTK_IS_WIDGET (xv_widget)) gtk_widget_queue_draw (GTK_WIDGET (xv_widget)); else - printf ("Warning, offscreen_damage_event received invalid xv pointer:%p\n", - xv_widget); + message ("Warning, offscreen_damage_event received invalid xv pointer:%p\n", + xv_widget); return FALSE; } +#endif /* USE_GTK */ -static void +void store_xwidget_event_string (struct xwidget *xw, const char *eventname, const char *eventstr) { @@ -240,7 +258,7 @@ store_xwidget_event_string (struct xwidget *xw, const char *eventname, kbd_buffer_store_event (&event); } -static void +void store_xwidget_js_callback_event (struct xwidget *xw, Lisp_Object proc, Lisp_Object argument) @@ -256,6 +274,7 @@ store_xwidget_js_callback_event (struct xwidget *xw, } +#ifdef USE_GTK void webkit_view_load_changed_cb (WebKitWebView *webkitwebview, WebKitLoadEvent load_event, @@ -486,6 +505,7 @@ xwidget_osr_event_set_embedder (GtkWidget *widget, GdkEvent *event, gtk_widget_get_window (xv->widget)); return FALSE; } +#endif /* USE_GTK */ /* Initializes and does initial placement of an xwidget view on screen. */ @@ -495,8 +515,10 @@ xwidget_init_view (struct xwidget *xww, int x, int y) { +#ifdef USE_GTK if (!xg_gtk_initialized) error ("xwidget_init_view: GTK has not been initialized"); +#endif struct xwidget_view *xv = allocate_xwidget_view (); Lisp_Object val; @@ -507,6 +529,7 @@ xwidget_init_view (struct xwidget *xww, XSETWINDOW (xv->w, s->w); XSETXWIDGET (xv->model, xww); +#ifdef USE_GTK if (EQ (xww->type, Qwebkit)) { xv->widget = gtk_drawing_area_new (); @@ -564,6 +587,10 @@ xwidget_init_view (struct xwidget *xww, xv->x = x; xv->y = y; gtk_widget_show_all (xv->widgetwindow); +#elif defined NS_IMPL_COCOA + nsxwidget_init_view (xv, xww, s, x, y); + nsxwidget_resize_view(xv, xww->width, xww->height); +#endif return xv; } @@ -576,6 +603,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) initialization. */ struct xwidget *xww = s->xwidget; struct xwidget_view *xv = xwidget_view_lookup (xww, s->w); + int text_area_x, text_area_y, text_area_width, text_area_height; int clip_right; int clip_bottom; int clip_top; @@ -587,13 +615,47 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) /* Do initialization here in the display loop because there is no other time to know things like window placement etc. Do not create a new view if we have found one that is usable. */ +#ifdef USE_GTK if (!xv) xv = xwidget_init_view (xww, s, x, y); - - int text_area_x, text_area_y, text_area_width, text_area_height; +#elif defined NS_IMPL_COCOA + if (!xv) + { + /* Enforce 1 to 1, model and view for macOS Cocoa webkit2. */ + if (xww->xv) + { + if (xwidget_hidden (xww->xv)) + { + Lisp_Object xvl; + XSETXWIDGET_VIEW (xvl, xww->xv); + Fdelete_xwidget_view (xvl); + } + else + { + message ("You can't share an xwidget (webkit2) among windows."); + return; + } + } + xv = xwidget_init_view (xww, s, x, y); + } +#endif window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y, &text_area_width, &text_area_height); + + /* Resize xwidget webkit if its container window size is changed in + some ways, for example, a buffer became hidden in small split + window, then it can appear front in merged whole window. */ + if (EQ (xww->type, Qwebkit) + && (xww->width != text_area_width || xww->height != text_area_height)) + { + Lisp_Object xwl; + XSETXWIDGET (xwl, xww); + Fxwidget_resize (xwl, + make_int (text_area_width), + make_int (text_area_height)); + } + clip_left = max (0, text_area_x - x); clip_right = max (clip_left, min (xww->width, text_area_x + text_area_width - x)); @@ -616,8 +678,14 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) /* Has it moved? */ if (moved) - gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), - xv->widgetwindow, x + clip_left, y + clip_top); + { +#ifdef USE_GTK + gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), + xv->widgetwindow, x + clip_left, y + clip_top); +#elif defined NS_IMPL_COCOA + nsxwidget_move_view (xv, x + clip_left, y + clip_top); +#endif + } /* Clip the widget window if some parts happen to be outside drawable area. An Emacs window is not a gtk window. A gtk window @@ -628,10 +696,16 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) || xv->clip_bottom != clip_bottom || xv->clip_top != clip_top || xv->clip_left != clip_left) { +#ifdef USE_GTK gtk_widget_set_size_request (xv->widgetwindow, clip_right - clip_left, clip_bottom - clip_top); gtk_fixed_move (GTK_FIXED (xv->widgetwindow), xv->widget, -clip_left, -clip_top); +#elif defined NS_IMPL_COCOA + nsxwidget_resize_view (xv, clip_right - clip_left, + clip_bottom - clip_top); + nsxwidget_move_widget_in_view (xv, -clip_left, -clip_top); +#endif xv->clip_right = clip_right; xv->clip_bottom = clip_bottom; @@ -645,16 +719,30 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) xwidgets background. It's just a visual glitch though. */ if (!xwidget_hidden (xv)) { +#ifdef USE_GTK gtk_widget_queue_draw (xv->widgetwindow); gtk_widget_queue_draw (xv->widget); +#elif defined NS_IMPL_COCOA + nsxwidget_set_needsdisplay (xv); +#endif } } -/* Macro that checks WEBKIT_IS_WEB_VIEW (xw->widget_osr) first. */ +static bool +xwidget_is_web_view (struct xwidget *xw) +{ +#ifdef USE_GTK + return xw->widget_osr != NULL && WEBKIT_IS_WEB_VIEW (xw->widget_osr); +#elif defined NS_IMPL_COCOA + return nsxwidget_is_web_view (xw); +#endif +} + +/* Macro that checks xwidget hold webkit web view first. */ #define WEBKIT_FN_INIT() \ CHECK_XWIDGET (xwidget); \ struct xwidget *xw = XXWIDGET (xwidget); \ - if (!xw->widget_osr || !WEBKIT_IS_WEB_VIEW (xw->widget_osr)) \ + if (!xwidget_is_web_view (xw)) \ { \ fputs ("ERROR xw->widget_osr does not hold a webkit instance\n", \ stdout); \ @@ -670,7 +758,11 @@ DEFUN ("xwidget-webkit-goto-uri", WEBKIT_FN_INIT (); CHECK_STRING (uri); uri = ENCODE_FILE (uri); +#ifdef USE_GTK webkit_web_view_load_uri (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (uri)); +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_goto_uri (xw, SSDATA (uri)); +#endif return Qnil; } @@ -684,14 +776,19 @@ DEFUN ("xwidget-webkit-zoom", if (FLOATP (factor)) { double zoom_change = XFLOAT_DATA (factor); +#ifdef USE_GTK webkit_web_view_set_zoom_level (WEBKIT_WEB_VIEW (xw->widget_osr), webkit_web_view_get_zoom_level (WEBKIT_WEB_VIEW (xw->widget_osr)) + zoom_change); +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_zoom (xw, zoom_change); +#endif } return Qnil; } +#ifdef USE_GTK /* Save script and fun in the script/callback save vector and return its index. */ static ptrdiff_t @@ -713,6 +810,7 @@ save_script_callback (struct xwidget *xw, Lisp_Object script, Lisp_Object fun) ASET (cbs, idx, Fcons (make_mint_ptr (xlispstrdup (script)), fun)); return idx; } +#endif DEFUN ("xwidget-webkit-execute-script", Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script, @@ -729,6 +827,7 @@ argument procedure FUN.*/) script = ENCODE_SYSTEM (script); +#ifdef USE_GTK /* Protect script and fun during GC. */ intptr_t idx = save_script_callback (xw, script, fun); @@ -742,6 +841,9 @@ argument procedure FUN.*/) NULL, /* cancelable */ webkit_javascript_finished_cb, (gpointer) idx); +#elif defined NS_IMPL_COCOA + nsxwidget_webkit_execute_script (xw, SSDATA (script), fun); +#endif return Qnil; } @@ -758,6 +860,7 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, xw->height = h; /* If there is an offscreen widget resize it first. */ +#ifdef USE_GTK if (xw->widget_osr) { gtk_window_resize (GTK_WINDOW (xw->widgetwindow_osr), xw->width, @@ -766,6 +869,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, xw->height); } +#elif defined NS_IMPL_COCOA + nsxwidget_resize (xw); +#endif for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail)) { @@ -773,8 +879,14 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, { struct xwidget_view *xv = XXWIDGET_VIEW (XCAR (tail)); if (XXWIDGET (xv->model) == xw) + { +#ifdef USE_GTK gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xw->width, xw->height); +#elif defined NS_IMPL_COCOA + nsxwidget_resize_view(xv, xw->width, xw->height); +#endif + } } } @@ -793,9 +905,13 @@ Emacs allocated area accordingly. */) (Lisp_Object xwidget) { CHECK_XWIDGET (xwidget); +#ifdef USE_GTK GtkRequisition requisition; gtk_widget_size_request (XXWIDGET (xwidget)->widget_osr, &requisition); return list2i (requisition.width, requisition.height); +#elif defined NS_IMPL_COCOA + return nsxwidget_get_size (XXWIDGET (xwidget)); +#endif } DEFUN ("xwidgetp", @@ -872,14 +988,19 @@ DEFUN ("delete-xwidget-view", { CHECK_XWIDGET_VIEW (xwidget_view); struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view); +#ifdef USE_GTK gtk_widget_destroy (xv->widgetwindow); - Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list); /* xv->model still has signals pointing to the view. There can be several views. Find the matching signals and delete them all. */ g_signal_handlers_disconnect_matched (XXWIDGET (xv->model)->widgetwindow_osr, G_SIGNAL_MATCH_DATA, 0, 0, 0, 0, xv->widget); +#elif defined NS_IMPL_COCOA + nsxwidget_delete_view (xv); +#endif + + Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list); return Qnil; } @@ -1156,11 +1277,19 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) xwidget_end_redisplay (w->current_matrix); */ struct xwidget_view *xv = xwidget_view_lookup (glyph->u.xwidget, w); +#ifdef USE_GTK /* FIXME: Is it safe to assume xwidget_view_lookup always succeeds here? If so, this comment can be removed. If not, the code probably needs fixing. */ eassume (xv); xwidget_touch (xv); +#elif defined NS_IMPL_COCOA + /* In NS xwidget, xv can be NULL for the second or + later views for a model, the result of 1 to 1 + model view relation enforcement. */ + if (xv) + xwidget_touch (xv); +#endif } } } @@ -1177,9 +1306,21 @@ xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix) if (XWINDOW (xv->w) == w) { if (xwidget_touched (xv)) - xwidget_show_view (xv); + { +#ifdef USE_GTK + xwidget_show_view (xv); +#elif defined NS_IMPL_COCOA + nsxwidget_show_view (xv); +#endif + } else - xwidget_hide_view (xv); + { +#ifdef USE_GTK + xwidget_hide_view (xv); +#elif defined NS_IMPL_COCOA + nsxwidget_hide_view (xv); +#endif + } } } } @@ -1198,6 +1339,7 @@ kill_buffer_xwidgets (Lisp_Object buffer) { CHECK_XWIDGET (xwidget); struct xwidget *xw = XXWIDGET (xwidget); +#ifdef USE_GTK if (xw->widget_osr && xw->widgetwindow_osr) { gtk_widget_destroy (xw->widget_osr); @@ -1211,6 +1353,9 @@ kill_buffer_xwidgets (Lisp_Object buffer) xfree (xmint_pointer (XCAR (cb))); ASET (xw->script_callbacks, idx, Qnil); } +#elif defined NS_IMPL_COCOA + nsxwidget_kill (xw); +#endif } } } diff --git a/src/xwidget.h b/src/xwidget.h index 99fa8bbd61..29f1153206 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -29,7 +29,13 @@ struct xwidget_view; struct window; #ifdef HAVE_XWIDGETS -# include + +#if defined (USE_GTK) +#include +#elif defined (NS_IMPL_COCOA) && defined (__OBJC__) +#import +#import "nsxwidget.h" +#endif struct xwidget { @@ -54,9 +60,25 @@ struct xwidget int height; int width; +#if defined (USE_GTK) /* For offscreen widgets, unused if not osr. */ GtkWidget *widget_osr; GtkWidget *widgetwindow_osr; +#elif defined (NS_IMPL_COCOA) +# ifdef __OBJC__ + /* For offscreen widgets, unused if not osr. */ + NSView *xwWidget; + XwWindow *xwWindow; + + /* Used only for xwidget types (such as webkit2) enforcing 1 to 1 + relationship between model and view. */ + struct xwidget_view *xv; +# else + void *xwWidget; + void *xwWindow; + struct xwidget_view *xv; +# endif +#endif /* Kill silently if Emacs is exited. */ bool_bf kill_without_query : 1; @@ -75,9 +97,20 @@ struct xwidget_view /* The "live" instance isn't drawn. */ bool hidden; +#if defined (USE_GTK) GtkWidget *widget; GtkWidget *widgetwindow; GtkWidget *emacswindow; +#elif defined (NS_IMPL_COCOA) +# ifdef __OBJC__ + XvWindow *xvWindow; + NSView *emacswindow; +# else + void *xvWindow; + void *emacswindow; +# endif +#endif + int x; int y; int clip_right; @@ -116,6 +149,14 @@ void x_draw_xwidget_glyph_string (struct glyph_string *); struct xwidget *lookup_xwidget (Lisp_Object spec); void xwidget_end_redisplay (struct window *, struct glyph_matrix *); void kill_buffer_xwidgets (Lisp_Object); +/* Defined in 'xwidget.c'. */ +void store_xwidget_event_string (struct xwidget *xw, + const char *eventname, + const char *eventstr); + +void store_xwidget_js_callback_event (struct xwidget *xw, + Lisp_Object proc, + Lisp_Object argument); #else INLINE_HEADER_BEGIN INLINE void syms_of_xwidget (void) {}