commit 61f5d6311c6757ad5c7883d737bbbf2407355940 (HEAD, refs/remotes/origin/master) Author: Michael R. Mauger Date: Sun Jun 10 20:01:36 2018 -0400 * lisp/progmodes/sql.el Add MariaDB support (Robert Cochran) (sql-product-alist): Add MariaDB entry (sql-mariadb-program, sql-mariadb-options, sql-mariadb-login-params, sql-mode-mariadb-font-lock): New variables, aliases of the MySQL equivalents (sql-mariadb, sql-comint-mariadb): New interaction mode functions for MariaDB (sql-mode-mysql-font-lock-keywords): Updated font-lock for MySQL and MariaDB diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 63428610a5..223fb2ec93 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -221,6 +221,7 @@ ;; Roman Scherer -- Connection documentation ;; Mark Wilkinson -- file-local variables ignored ;; Simen Heggestøyl -- Postgres database completion +;; Robert Cochran -- MariaDB support ;; @@ -416,6 +417,21 @@ file. Since that is a plaintext file, this could be dangerous." :prompt-regexp "^SQL>" :prompt-length 4) + (mariadb + :name "MariaDB" + :free-software t + :font-lock sql-mode-mariadb-font-lock-keywords + :sqli-program sql-mariadb-program + :sqli-options sql-mariadb-options + :sqli-login sql-mariadb-login-params + :sqli-comint-func sql-comint-mariadb + :list-all "SHOW TABLES;" + :list-table "DESCRIBE %s;" + :prompt-regexp "^MariaDB \\[.*]> " + :prompt-cont-regexp "^ [\"'`-]> " + :syntax-alist ((?# . "< b")) + :input-filter sql-remove-tabs-filter) + (ms :name "Microsoft" :font-lock sql-mode-ms-font-lock-keywords @@ -959,10 +975,19 @@ Starts `sql-interactive-mode' after doing some setup." :version "26.1" :group 'SQL) +;; Customization for MariaDB + +;; MariaDB is a drop-in replacement for MySQL, so just make the +;; MariaDB variables aliases of the MySQL ones. + +(defvaralias 'sql-mariadb-program 'sql-mysql-program) +(defvaralias 'sql-mariadb-options 'sql-mysql-options) +(defvaralias 'sql-mariadb-login-params 'sql-mysql-login-params) + ;; Customization for MySQL (defcustom sql-mysql-program "mysql" - "Command to start mysql by TcX. + "Command to start mysql by Oracle. Starts `sql-interactive-mode' after doing some setup." :type 'file @@ -2321,75 +2346,148 @@ regular expressions are created during compilation by calling the function `regexp-opt'. Therefore, take a look at the source before you define your own `sql-mode-solid-font-lock-keywords'.") +(defvaralias 'sql-mode-mariadb-font-lock-keywords 'sql-mode-mysql-font-lock-keywords + "MariaDB is SQL compatible with MySQL.") + (defvar sql-mode-mysql-font-lock-keywords (eval-when-compile (list ;; MySQL Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"ascii" "avg" "bdmpolyfromtext" "bdmpolyfromwkb" "bdpolyfromtext" -"bdpolyfromwkb" "benchmark" "bin" "bit_and" "bit_length" "bit_or" -"bit_xor" "both" "cast" "char_length" "character_length" "coalesce" -"concat" "concat_ws" "connection_id" "conv" "convert" "count" -"curdate" "current_date" "current_time" "current_timestamp" "curtime" -"elt" "encrypt" "export_set" "field" "find_in_set" "found_rows" "from" +"acos" "adddate" "addtime" "aes_decrypt" "aes_encrypt" "area" +"asbinary" "ascii" "asin" "astext" "aswkb" "aswkt" "atan" "atan2" +"avg" "bdmpolyfromtext" "bdmpolyfromwkb" "bdpolyfromtext" +"bdpolyfromwkb" "benchmark" "bin" "binlog_gtid_pos" "bit_and" +"bit_count" "bit_length" "bit_or" "bit_xor" "both" "boundary" "buffer" +"cast" "ceil" "ceiling" "centroid" "character_length" "char_length" +"charset" "coalesce" "coercibility" "column_add" "column_check" +"column_create" "column_delete" "column_exists" "column_get" +"column_json" "column_list" "compress" "concat" "concat_ws" +"connection_id" "conv" "convert" "convert_tz" "convexhull" "cos" "cot" +"count" "crc32" "crosses" "cume_dist" "cume_dist" "curdate" +"current_date" "current_time" "current_timestamp" "curtime" "date_add" +"datediff" "date_format" "date_sub" "dayname" "dayofmonth" "dayofweek" +"dayofyear" "decode" "decode_histogram" "degrees" "dense_rank" +"dense_rank" "des_decrypt" "des_encrypt" "dimension" "disjoint" "div" +"elt" "encode" "encrypt" "endpoint" "envelope" "exp" "export_set" +"exteriorring" "extractvalue" "field" "find_in_set" "floor" "format" +"found_rows" "from" "from_base64" "from_days" "from_unixtime" "geomcollfromtext" "geomcollfromwkb" "geometrycollectionfromtext" "geometrycollectionfromwkb" "geometryfromtext" "geometryfromwkb" -"geomfromtext" "geomfromwkb" "get_lock" "group_concat" "hex" "ifnull" -"instr" "interval" "isnull" "last_insert_id" "lcase" "leading" -"length" "linefromtext" "linefromwkb" "linestringfromtext" -"linestringfromwkb" "load_file" "locate" "lower" "lpad" "ltrim" -"make_set" "master_pos_wait" "max" "mid" "min" "mlinefromtext" -"mlinefromwkb" "mpointfromtext" "mpointfromwkb" "mpolyfromtext" -"mpolyfromwkb" "multilinestringfromtext" "multilinestringfromwkb" +"geometryn" "geometrytype" "geomfromtext" "geomfromwkb" "get_format" +"get_lock" "glength" "greatest" "group_concat" "hex" "ifnull" +"inet6_aton" "inet6_ntoa" "inet_aton" "inet_ntoa" "instr" +"interiorringn" "intersects" "interval" "isclosed" "isempty" +"is_free_lock" "is_ipv4" "is_ipv4_compat" "is_ipv4_mapped" "is_ipv6" +"isnull" "isring" "issimple" "is_used_lock" "json_array" +"json_array_append" "json_array_insert" "json_compact" "json_contains" +"json_contains_path" "json_depth" "json_detailed" "json_exists" +"json_extract" "json_insert" "json_keys" "json_length" "json_loose" +"json_merge" "json_object" "json_query" "json_quote" "json_remove" +"json_replace" "json_search" "json_set" "json_type" "json_unquote" +"json_valid" "json_value" "lag" "last_day" "last_insert_id" "lastval" +"last_value" "last_value" "lcase" "lead" "leading" "least" "length" +"linefromtext" "linefromwkb" "linestringfromtext" "linestringfromwkb" +"ln" "load_file" "locate" "log" "log10" "log2" "lower" "lpad" "ltrim" +"makedate" "make_set" "maketime" "master_gtid_wait" "master_pos_wait" +"max" "mbrcontains" "mbrdisjoint" "mbrequal" "mbrintersects" +"mbroverlaps" "mbrtouches" "mbrwithin" "md5" "median" +"mid" "min" "mlinefromtext" "mlinefromwkb" "monthname" +"mpointfromtext" "mpointfromwkb" "mpolyfromtext" "mpolyfromwkb" +"multilinestringfromtext" "multilinestringfromwkb" "multipointfromtext" "multipointfromwkb" "multipolygonfromtext" -"multipolygonfromwkb" "now" "nullif" "oct" "octet_length" "ord" -"pointfromtext" "pointfromwkb" "polyfromtext" "polyfromwkb" -"polygonfromtext" "polygonfromwkb" "position" "quote" "rand" -"release_lock" "repeat" "replace" "reverse" "rpad" "rtrim" "soundex" -"space" "std" "stddev" "substring" "substring_index" "sum" "sysdate" -"trailing" "trim" "ucase" "unix_timestamp" "upper" "user" "variance" +"multipolygonfromwkb" "name_const" "nextval" "now" "nth_value" "ntile" +"ntile" "nullif" "numgeometries" "numinteriorrings" "numpoints" "oct" +"octet_length" "old_password" "ord" "percentile_cont" +"percentile_disc" "percent_rank" "percent_rank" "period_add" +"period_diff" "pi" "pointfromtext" "pointfromwkb" "pointn" +"pointonsurface" "polyfromtext" "polyfromwkb" "polygonfromtext" +"polygonfromwkb" "position" "pow" "power" "quote" "radians" +"rand" "rank" "rank" "regexp" "regexp_instr" "regexp_replace" +"regexp_substr" "release_lock" "repeat" "replace" "reverse" "rlike" +"row_number" "row_number" "rpad" "rtrim" "sec_to_time" "setval" "sha" +"sha1" "sha2" "sign" "sin" "sleep" "soundex" "space" +"spider_bg_direct_sql" "spider_copy_tables" "spider_direct_sql" +"spider_flush_table_mon_cache" "sqrt" "srid" "st_area" "startpoint" +"st_asbinary" "st_astext" "st_aswkb" "st_aswkt" "st_boundary" +"st_buffer" "st_centroid" "st_contains" "st_convexhull" "st_crosses" +"std" "stddev" "stddev_pop" "stddev_samp" "st_difference" +"st_dimension" "st_disjoint" "st_distance" "st_endpoint" "st_envelope" +"st_equals" "st_exteriorring" "st_geomcollfromtext" +"st_geomcollfromwkb" "st_geometrycollectionfromtext" +"st_geometrycollectionfromwkb" "st_geometryfromtext" +"st_geometryfromwkb" "st_geometryn" "st_geometrytype" +"st_geomfromtext" "st_geomfromwkb" "st_interiorringn" +"st_intersection" "st_intersects" "st_isclosed" "st_isempty" +"st_isring" "st_issimple" "st_length" "st_linefromtext" +"st_linefromwkb" "st_linestringfromtext" "st_linestringfromwkb" +"st_numgeometries" "st_numinteriorrings" "st_numpoints" "st_overlaps" +"st_pointfromtext" "st_pointfromwkb" "st_pointn" "st_pointonsurface" +"st_polyfromtext" "st_polyfromwkb" "st_polygonfromtext" +"st_polygonfromwkb" "strcmp" "st_relate" "str_to_date" "st_srid" +"st_startpoint" "st_symdifference" "st_touches" "st_union" "st_within" +"st_x" "st_y" "subdate" "substr" "substring" "substring_index" +"subtime" "sum" "sysdate" "tan" "timediff" "time_format" +"timestampadd" "timestampdiff" "time_to_sec" "to_base64" "to_days" +"to_seconds" "touches" "trailing" "trim" "ucase" "uncompress" +"uncompressed_length" "unhex" "unix_timestamp" "updatexml" "upper" +"user" "utc_date" "utc_time" "utc_timestamp" "uuid" "uuid_short" +"variance" "var_pop" "var_samp" "version" "weekday" +"weekofyear" "weight_string" "within" ) ;; MySQL Keywords (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"action" "add" "after" "against" "all" "alter" "and" "as" "asc" -"auto_increment" "avg_row_length" "bdb" "between" "by" "cascade" -"case" "change" "character" "check" "checksum" "close" "collate" -"collation" "column" "columns" "comment" "committed" "concurrent" -"constraint" "create" "cross" "data" "database" "default" -"delay_key_write" "delayed" "delete" "desc" "directory" "disable" -"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else" "elseif" -"enable" "enclosed" "end" "escaped" "exists" "fields" "first" "for" -"force" "foreign" "from" "full" "fulltext" "global" "group" "handler" -"having" "heap" "high_priority" "if" "ignore" "in" "index" "infile" -"inner" "insert" "insert_method" "into" "is" "isam" "isolation" "join" -"key" "keys" "last" "left" "level" "like" "limit" "lines" "load" -"local" "lock" "low_priority" "match" "max_rows" "merge" "min_rows" -"mode" "modify" "mrg_myisam" "myisam" "natural" "next" "no" "not" -"null" "offset" "oj" "on" "open" "optionally" "or" "order" "outer" -"outfile" "pack_keys" "partial" "password" "prev" "primary" -"procedure" "quick" "raid0" "raid_type" "read" "references" "rename" -"repeatable" "restrict" "right" "rollback" "rollup" "row_format" -"savepoint" "select" "separator" "serializable" "session" "set" -"share" "show" "sql_big_result" "sql_buffer_result" "sql_cache" -"sql_calc_found_rows" "sql_no_cache" "sql_small_result" "starting" -"straight_join" "striped" "table" "tables" "temporary" "terminated" -"then" "to" "transaction" "truncate" "type" "uncommitted" "union" -"unique" "unlock" "update" "use" "using" "values" "when" "where" -"with" "write" "xor" +"accessible" "action" "add" "after" "against" "all" "alter" "analyze" +"and" "as" "asc" "auto_increment" "avg_row_length" "bdb" "between" +"body" "by" "cascade" "case" "change" "character" "check" "checksum" +"close" "collate" "collation" "column" "columns" "comment" "committed" +"concurrent" "condition" "constraint" "create" "cross" "data" +"database" "databases" "default" "delayed" "delay_key_write" "delete" +"desc" "directory" "disable" "distinct" "distinctrow" "do" "drop" +"dual" "dumpfile" "duplicate" "else" "elseif" "elsif" "enable" +"enclosed" "end" "escaped" "exists" "exit" "explain" "fields" "first" +"for" "force" "foreign" "from" "full" "fulltext" "global" "group" +"handler" "having" "heap" "high_priority" "history" "if" "ignore" +"ignore_server_ids" "in" "index" "infile" "inner" "insert" +"insert_method" "into" "is" "isam" "isolation" "join" "key" "keys" +"kill" "last" "leave" "left" "level" "like" "limit" "linear" "lines" +"load" "local" "lock" "long" "loop" "low_priority" +"master_heartbeat_period" "master_ssl_verify_server_cert" "match" +"max_rows" "maxvalue" "merge" "min_rows" "mode" "modify" "mrg_myisam" +"myisam" "natural" "next" "no" "not" "no_write_to_binlog" "null" +"offset" "oj" "on" "open" "optimize" "optionally" "or" "order" "outer" +"outfile" "over" "package" "pack_keys" "partial" "partition" +"password" "period" "prev" "primary" "procedure" "purge" "quick" +"raid0" "raid_type" "raise" "range" "read" "read_write" "references" +"release" "rename" "repeatable" "require" "resignal" "restrict" +"returning" "right" "rollback" "rollup" "row_format" "rowtype" +"savepoint" "schemas" "select" "separator" "serializable" "session" +"set" "share" "show" "signal" "slow" "spatial" "sql_big_result" +"sql_buffer_result" "sql_cache" "sql_calc_found_rows" "sql_no_cache" +"sql_small_result" "ssl" "starting" "straight_join" "striped" +"system_time" "table" "tables" "temporary" "terminated" "then" "to" +"transaction" "truncate" "type" "uncommitted" "undo" "union" "unique" +"unlock" "update" "use" "using" "values" "versioning" "when" "where" +"while" "window" "with" "write" "xor" ) ;; MySQL Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"bigint" "binary" "bit" "blob" "bool" "boolean" "char" "curve" "date" -"datetime" "dec" "decimal" "double" "enum" "fixed" "float" "geometry" -"geometrycollection" "int" "integer" "line" "linearring" "linestring" -"longblob" "longtext" "mediumblob" "mediumint" "mediumtext" +"bigint" "binary" "bit" "blob" "bool" "boolean" "byte" "char" "curve" +"date" "datetime" "day" "day_hour" "day_microsecond" "day_minute" +"day_second" "dec" "decimal" "double" "enum" "fixed" "float" "float4" +"float8" "geometry" "geometrycollection" "hour" "hour_microsecond" +"hour_minute" "hour_second" "int" "int1" "int2" "int3" "int4" "int8" +"integer" "json" "line" "linearring" "linestring" "longblob" +"longtext" "mediumblob" "mediumint" "mediumtext" "microsecond" +"middleint" "minute" "minute_microsecond" "minute_second" "month" "multicurve" "multilinestring" "multipoint" "multipolygon" "multisurface" "national" "numeric" "point" "polygon" "precision" -"real" "smallint" "surface" "text" "time" "timestamp" "tinyblob" -"tinyint" "tinytext" "unsigned" "varchar" "year" "year2" "year4" -"zerofill" +"quarter" "real" "second" "second_microsecond" "signed" "smallint" +"surface" "text" "time" "timestamp" "tinyblob" "tinyint" "tinytext" +"unsigned" "varbinary" "varchar" "varcharacter" "week" "year" "year2" +"year4" "year_month" "zerofill" ))) "MySQL SQL keywords used by font-lock. @@ -4875,6 +4973,46 @@ The default comes from `process-coding-system-alist' and (list sql-database))))) (sql-comint product params buf-name))) +;;;###autoload +(defun sql-mariadb (&optional buffer) + "Run mysql by MariaDB as an inferior process. + +MariaDB is free software. + +If buffer `*SQL*' exists but no process is running, make a new process. +If buffer exists and a process is running, just switch to buffer +`*SQL*'. + +Interpreter used comes from variable `sql-mariadb-program'. Login uses +the variables `sql-user', `sql-password', `sql-database', and +`sql-server' as defaults, if set. Additional command line parameters +can be stored in the list `sql-mariadb-options'. + +The buffer is put in SQL interactive mode, giving commands for sending +input. See `sql-interactive-mode'. + +To set the buffer name directly, use \\[universal-argument] +before \\[sql-mariadb]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + +To specify a coding system for converting non-ASCII characters +in the input and output to the process, use \\[universal-coding-system-argument] +before \\[sql-mariadb]. You can also specify this with \\[set-buffer-process-coding-system] +in the SQL buffer, after you start the process. +The default comes from `process-coding-system-alist' and +`default-process-coding-system'. + +\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" + (interactive "P") + (sql-product-interactive 'mariadb buffer)) + +(defun sql-comint-mariadb (product options &optional buf-name) + "Create comint buffer and connect to MariaDB. + +Use the MySQL comint driver since the two are compatible." + (sql-comint-mysql product options buf-name)) + ;;;###autoload commit 1feb2e221349f26ec26bc684e0cce2acecbed3ca Author: Thomas Fitzsimmons Date: Fri Jun 8 22:41:28 2018 -0400 soap-client: Add byte-code compatibility function (Bug#31742) * lisp/net/soap-client.el: Bump version to 3.1.4. (soap-type-of): New function. (soap-resolve-references, soap-decode-type) (soap-encode-attributes, soap-encode-value): Replace aref calls with calls to soap-type-of. * lisp/net/soap-inspect.el (soap-sample-value, soap-inspect): Replace aref calls with calls to soap-type-of. Co-authored-by: Noam Postavsky diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 3996da0b55..17f83082f8 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,7 +5,7 @@ ;; Author: Alexandru Harsanyi ;; Author: Thomas Fitzsimmons ;; Created: December, 2009 -;; Version: 3.1.3 +;; Version: 3.1.4 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client @@ -685,8 +685,17 @@ This is a specialization of `soap-decode-type' for (anyType (soap-decode-any-type node)) (Array (soap-decode-array node)))))) +(defun soap-type-of (element) + "Return the type of ELEMENT." + ;; Support Emacs < 26 byte-code running in Emacs >= 26 sessions + ;; (Bug#31742). + (let ((type (type-of element))) + (if (eq type 'vector) + (aref element 0) ; For Emacs 25 and earlier. + type))) + ;; Register methods for `soap-xs-basic-type' -(let ((tag (aref (make-soap-xs-basic-type) 0))) +(let ((tag (soap-type-of (make-soap-xs-basic-type)))) (put tag 'soap-attribute-encoder #'soap-encode-xs-basic-type-attributes) (put tag 'soap-encoder #'soap-encode-xs-basic-type) (put tag 'soap-decoder #'soap-decode-xs-basic-type)) @@ -915,7 +924,7 @@ This is a specialization of `soap-decode-type' for (soap-decode-type type node))) ;; Register methods for `soap-xs-element' -(let ((tag (aref (make-soap-xs-element) 0))) +(let ((tag (soap-type-of (make-soap-xs-element)))) (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-element) (put tag 'soap-attribute-encoder #'soap-encode-xs-element-attributes) (put tag 'soap-encoder #'soap-encode-xs-element) @@ -1011,7 +1020,7 @@ See also `soap-wsdl-resolve-references'." (setf (soap-xs-attribute-reference attribute) (soap-wsdl-get reference wsdl predicate))))) -(put (aref (make-soap-xs-attribute) 0) +(put (soap-type-of (make-soap-xs-attribute)) 'soap-resolve-references #'soap-resolve-references-for-xs-attribute) (defun soap-resolve-references-for-xs-attribute-group (attribute-group wsdl) @@ -1036,7 +1045,7 @@ See also `soap-wsdl-resolve-references'." (setf (soap-xs-attribute-group-attribute-groups attribute-group) (soap-xs-attribute-group-attribute-groups resolved)))))) -(put (aref (make-soap-xs-attribute-group) 0) +(put (soap-type-of (make-soap-xs-attribute-group)) 'soap-resolve-references #'soap-resolve-references-for-xs-attribute-group) ;;;;; soap-xs-simple-type @@ -1374,7 +1383,7 @@ This is a specialization of `soap-decode-type' for (soap-validate-xs-simple-type value type)))) ;; Register methods for `soap-xs-simple-type' -(let ((tag (aref (make-soap-xs-simple-type) 0))) +(let ((tag (soap-type-of (make-soap-xs-simple-type)))) (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-simple-type) (put tag 'soap-attribute-encoder #'soap-encode-xs-simple-type-attributes) @@ -1927,7 +1936,7 @@ This is a specialization of `soap-decode-type' for (soap-xs-complex-type-indicator type))))) ;; Register methods for `soap-xs-complex-type' -(let ((tag (aref (make-soap-xs-complex-type) 0))) +(let ((tag (soap-type-of (make-soap-xs-complex-type)))) (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-complex-type) (put tag 'soap-attribute-encoder #'soap-encode-xs-complex-type-attributes) @@ -2147,7 +2156,7 @@ This is a generic function which invokes a specific resolver function depending on the type of the ELEMENT. If ELEMENT has no resolver function, it is silently ignored." - (let ((resolver (get (aref element 0) 'soap-resolve-references))) + (let ((resolver (get (soap-type-of element) 'soap-resolve-references))) (when resolver (funcall resolver element wsdl)))) @@ -2272,13 +2281,13 @@ See also `soap-wsdl-resolve-references'." ;; Install resolvers for our types (progn - (put (aref (make-soap-message) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-message)) 'soap-resolve-references 'soap-resolve-references-for-message) - (put (aref (make-soap-operation) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-operation)) 'soap-resolve-references 'soap-resolve-references-for-operation) - (put (aref (make-soap-binding) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-binding)) 'soap-resolve-references 'soap-resolve-references-for-binding) - (put (aref (make-soap-port) 0) 'soap-resolve-references + (put (soap-type-of (make-soap-port)) 'soap-resolve-references 'soap-resolve-references-for-port)) (defun soap-wsdl-resolve-references (wsdl) @@ -2685,16 +2694,17 @@ decode function to perform the actual decoding." (cond ((listp type) (catch 'done (dolist (union-member type) - (let* ((decoder (get (aref union-member 0) + (let* ((decoder (get (soap-type-of union-member) 'soap-decoder)) (result (ignore-errors (funcall decoder union-member node)))) (when result (throw 'done result)))))) (t - (let ((decoder (get (aref type 0) 'soap-decoder))) + (let ((decoder (get (soap-type-of type) 'soap-decoder))) (cl-assert decoder nil - "no soap-decoder for %s type" (aref type 0)) + "no soap-decoder for %s type" + (soap-type-of type)) (funcall decoder type node)))))))))) (defun soap-decode-any-type (node) @@ -2878,9 +2888,9 @@ for the type and calls that specialized function to do the work. Attributes are inserted in the current buffer at the current position." - (let ((attribute-encoder (get (aref type 0) 'soap-attribute-encoder))) + (let ((attribute-encoder (get (soap-type-of type) 'soap-attribute-encoder))) (cl-assert attribute-encoder nil - "no soap-attribute-encoder for %s type" (aref type 0)) + "no soap-attribute-encoder for %s type" (soap-type-of type)) (funcall attribute-encoder value type))) (defun soap-encode-value (value type) @@ -2892,8 +2902,8 @@ TYPE is one of the soap-*-type structures which defines how VALUE is to be encoded. This is a generic function which finds an encoder function based on TYPE and calls that encoder to do the work." - (let ((encoder (get (aref type 0) 'soap-encoder))) - (cl-assert encoder nil "no soap-encoder for %s type" (aref type 0)) + (let ((encoder (get (soap-type-of type) 'soap-encoder))) + (cl-assert encoder nil "no soap-encoder for %s type" (soap-type-of type)) (funcall encoder value type)) (when (soap-element-namespace-tag type) (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type)))) diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index 050be453db..252b1f35ff 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -49,10 +49,10 @@ for encoding it using TYPE when making SOAP requests. This is a generic function, depending on TYPE a specific function will be called." - (let ((sample-value (get (aref type 0) 'soap-sample-value))) + (let ((sample-value (get (soap-type-of type) 'soap-sample-value))) (if sample-value (funcall sample-value type) - (error "Cannot provide sample value for type %s" (aref type 0))))) + (error "Cannot provide sample value for type %s" (soap-type-of type))))) (defun soap-sample-value-for-xs-basic-type (type) "Provide a sample value for TYPE, an xs-basic-type. @@ -174,31 +174,31 @@ This is a specialization of `soap-sample-value' for (progn ;; Install soap-sample-value methods for our types - (put (aref (make-soap-xs-basic-type) 0) + (put (soap-type-of (make-soap-xs-basic-type)) 'soap-sample-value 'soap-sample-value-for-xs-basic-type) - (put (aref (make-soap-xs-element) 0) + (put (soap-type-of (make-soap-xs-element)) 'soap-sample-value 'soap-sample-value-for-xs-element) - (put (aref (make-soap-xs-attribute) 0) + (put (soap-type-of (make-soap-xs-attribute)) 'soap-sample-value 'soap-sample-value-for-xs-attribute) - (put (aref (make-soap-xs-attribute) 0) + (put (soap-type-of (make-soap-xs-attribute)) 'soap-sample-value 'soap-sample-value-for-xs-attribute-group) - (put (aref (make-soap-xs-simple-type) 0) + (put (soap-type-of (make-soap-xs-simple-type)) 'soap-sample-value 'soap-sample-value-for-xs-simple-type) - (put (aref (make-soap-xs-complex-type) 0) + (put (soap-type-of (make-soap-xs-complex-type)) 'soap-sample-value 'soap-sample-value-for-xs-complex-type) - (put (aref (make-soap-message) 0) + (put (soap-type-of (make-soap-message)) 'soap-sample-value 'soap-sample-value-for-message)) @@ -222,7 +222,7 @@ Used to implement the BACK button.") The buffer is populated with information about ELEMENT with links to its sub elements. If ELEMENT is the WSDL document itself, the entire WSDL can be inspected." - (let ((inspect (get (aref element 0) 'soap-inspect))) + (let ((inspect (get (soap-type-of element) 'soap-inspect))) (unless inspect (error "Soap-inspect: no inspector for element")) @@ -507,39 +507,39 @@ TYPE is a `soap-xs-complex-type'" (progn ;; Install the soap-inspect methods for our types - (put (aref (make-soap-xs-basic-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-basic-type)) 'soap-inspect 'soap-inspect-xs-basic-type) - (put (aref (make-soap-xs-element) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-element)) 'soap-inspect 'soap-inspect-xs-element) - (put (aref (make-soap-xs-simple-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-simple-type)) 'soap-inspect 'soap-inspect-xs-simple-type) - (put (aref (make-soap-xs-complex-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-complex-type)) 'soap-inspect 'soap-inspect-xs-complex-type) - (put (aref (make-soap-xs-attribute) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-attribute)) 'soap-inspect 'soap-inspect-xs-attribute) - (put (aref (make-soap-xs-attribute-group) 0) 'soap-inspect + (put (soap-type-of (make-soap-xs-attribute-group)) 'soap-inspect 'soap-inspect-xs-attribute-group) - (put (aref (make-soap-message) 0) 'soap-inspect + (put (soap-type-of (make-soap-message)) 'soap-inspect 'soap-inspect-message) - (put (aref (make-soap-operation) 0) 'soap-inspect + (put (soap-type-of (make-soap-operation)) 'soap-inspect 'soap-inspect-operation) - (put (aref (make-soap-port-type) 0) 'soap-inspect + (put (soap-type-of (make-soap-port-type)) 'soap-inspect 'soap-inspect-port-type) - (put (aref (make-soap-binding) 0) 'soap-inspect + (put (soap-type-of (make-soap-binding)) 'soap-inspect 'soap-inspect-binding) - (put (aref (make-soap-port) 0) 'soap-inspect + (put (soap-type-of (make-soap-port)) 'soap-inspect 'soap-inspect-port) - (put (aref (soap-make-wsdl "origin") 0) 'soap-inspect + (put (soap-type-of (soap-make-wsdl "origin")) 'soap-inspect 'soap-inspect-wsdl)) (provide 'soap-inspect) commit 0626d5aba518a6d22ffacd7a1e3f4c70d7248e5f Author: Daniel Colascione Date: Mon Jun 11 16:54:23 2018 -0700 Add after-delete-frame-functions Instead of working around the behavior delete-frame-functions, just add an after-delete-frame-functions hook. * doc/lispref/frames.texi (Deleting Frames): Document `after-delete-frame-functions'. * etc/NEWS: Mention `after-delete-frame-functions'. * lisp/frame.el (blink-cursor--should-blink): (blink-cursor--rescan-frames, blink-frame-mode): Get rid of the ugly ignored-frame parameter and switch from `delete-frame-functions' to `after-delete-frame-functions'. * src/frame.c (syms_of_frame): New variable `after-delete-frame-functions'. (delete_frame): Use it. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 3a97ec0138..5e8b5b46d5 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2530,6 +2530,7 @@ it. @deffn Command delete-frame &optional frame force @vindex delete-frame-functions +@vindex after-delete-frame-functions This function deletes the frame @var{frame}. The argument @var{frame} must specify a live frame (see below) and defaults to the selected frame. @@ -2541,7 +2542,9 @@ performed recursively; so this step makes sure that no other frames with @var{frame} as their ancestor will exist. Then, unless @var{frame} specifies a tooltip, this function runs the hook @code{delete-frame-functions} (each function getting one argument, -@var{frame}) before actually killing the frame. +@var{frame}) before actually killing the frame. After actually killing +the frame and removing the frame from the frame list, @code{delete-frame} +runs @code{after-delete-frame-functions}. Note that a frame cannot be deleted as long as its minibuffer serves as surrogate minibuffer for another frame (@pxref{Minibuffers and Frames}). diff --git a/etc/NEWS b/etc/NEWS index 7b14b9f896..402dcb13c7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -582,6 +582,12 @@ manual for more details. * Lisp Changes in Emacs 27.1 ++++ +** New hook `after-delete-frame-functions'. Works like + `delete-frame-functions', but runs after the frame to be deleted + has been made dead and removed from the frame list, simplifying + some kinds of code. + +++ ** New focus state inspection interface: `focus-in-hook' and `focus-out-hook' are marked obsolete. Instead, attach to diff --git a/lisp/frame.el b/lisp/frame.el index a0e7b35a13..38f785901e 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2416,40 +2416,33 @@ frame receives focus." (cancel-timer blink-cursor-idle-timer) (setq blink-cursor-idle-timer nil))) -(defun blink-cursor--should-blink (&optional ignored-frame) +(defun blink-cursor--should-blink () "Determine whether we should be blinking. -Returns whether we have any focused non-TTY frame. IGNORED-FRAME -is a frame to ignore during the scan, used when we want to ignore -a frame about to be deleted." +Returns whether we have any focused non-TTY frame." (and blink-cursor-mode (let ((frame-list (frame-list)) (any-graphical-focused nil)) (while frame-list (let ((frame (pop frame-list))) - (when (and (not (eq frame ignored-frame)) - (display-graphic-p frame) - (frame-focus-state frame)) + (when (and (display-graphic-p frame) (frame-focus-state frame)) (setf any-graphical-focused t) (setf frame-list nil)))) any-graphical-focused))) -(defun blink-cursor-check (&optional ignored-frame) +(defun blink-cursor-check () "Check if cursor blinking shall be restarted. This is done when a frame gets focus. Blink timers may be stopped by `blink-cursor-suspend'. Internally calls `blink-cursor--should-blink' and returns its result." - (let ((should-blink (blink-cursor--should-blink ignored-frame))) + (let ((should-blink (blink-cursor--should-blink))) (when (and should-blink (not blink-cursor-idle-timer)) (remove-hook 'post-command-hook 'blink-cursor-check) (blink-cursor--start-idle-timer)) should-blink)) -(defun blink-cursor--rescan-frames (&optional ignored-frame) - "Called when the set of focused frames changes or when we -delete a frame. Re-check whether we want to enable blinking. -IGNORED-FRAME is there so we ignore a frame about to be deleted -when we're called under via `delete-frame-functions'." - (unless (blink-cursor-check ignored-frame) +(defun blink-cursor--rescan-frames (&optional _ign) + "Called when the set of focused frames changes or when we delete a frame." + (unless (blink-cursor-check) (blink-cursor-suspend))) (define-minor-mode blink-cursor-mode @@ -2474,11 +2467,11 @@ terminals, cursor blinking is controlled by the terminal." :group 'cursor :global t (blink-cursor-suspend) - (remove-hook 'delete-frame-functions #'blink-cursor--rescan-frames) + (remove-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames) (remove-function after-focus-change-function #'blink-cursor--rescan-frames) (when blink-cursor-mode (add-function :after after-focus-change-function #'blink-cursor--rescan-frames) - (add-hook 'delete-frame-functions #'blink-cursor--rescan-frames) + (add-hook 'after-delete-frame-functions #'blink-cursor--rescan-frames) (blink-cursor--start-idle-timer))) diff --git a/src/frame.c b/src/frame.c index bf0269292d..d477c1acc3 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2161,6 +2161,16 @@ delete_frame (Lisp_Object frame, Lisp_Object force) if (!is_tooltip_frame) update_mode_lines = 15; + /* Now run the post-deletion hooks. */ + if (NILP (Vrun_hooks) || is_tooltip_frame) + ; + else if (EQ (force, Qnoelisp)) + pending_funcalls + = Fcons (list3 (Qrun_hook_with_args, Qafter_delete_frame_functions, frame), + pending_funcalls); + else + safe_call2 (Qrun_hook_with_args, Qafter_delete_frame_functions, frame); + return Qnil; } @@ -5897,6 +5907,14 @@ recursively). */); Vdelete_frame_functions = Qnil; DEFSYM (Qdelete_frame_functions, "delete-frame-functions"); + DEFVAR_LISP ("after-delete-frame-functions", + Vafter_delete_frame_functions, + doc: /* Functions run after deleting a frame. +The functions are run with one arg, the frame that was deleted and +which is now dead. */); + Vafter_delete_frame_functions = Qnil; + DEFSYM (Qafter_delete_frame_functions, "after-delete-frame-functions"); + DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode, doc: /* Non-nil if Menu-Bar mode is enabled. See the command `menu-bar-mode' for a description of this minor mode. commit 4ff438a45a5d3e380622ceaf4b9aa93cf89be4c8 Author: Daniel Colascione Date: Mon Jun 11 16:08:29 2018 -0700 Make blink-cursor-mode use new focus functions * lisp/frame.el (blink-cursor--should-blink): New function. (blink-cursor-check): Call it. (blink-cursor--rescan-frames): New function. (blink-cursor-mode): Wire up `blink-cursor--rescan-frames`; stop using `focus-in-hook' and `focus-out-hook'. diff --git a/lisp/frame.el b/lisp/frame.el index 2a2391e8a5..a0e7b35a13 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2416,15 +2416,41 @@ frame receives focus." (cancel-timer blink-cursor-idle-timer) (setq blink-cursor-idle-timer nil))) -(defun blink-cursor-check () +(defun blink-cursor--should-blink (&optional ignored-frame) + "Determine whether we should be blinking. +Returns whether we have any focused non-TTY frame. IGNORED-FRAME +is a frame to ignore during the scan, used when we want to ignore +a frame about to be deleted." + (and blink-cursor-mode + (let ((frame-list (frame-list)) + (any-graphical-focused nil)) + (while frame-list + (let ((frame (pop frame-list))) + (when (and (not (eq frame ignored-frame)) + (display-graphic-p frame) + (frame-focus-state frame)) + (setf any-graphical-focused t) + (setf frame-list nil)))) + any-graphical-focused))) + +(defun blink-cursor-check (&optional ignored-frame) "Check if cursor blinking shall be restarted. -This is done when a frame gets focus. Blink timers may be stopped by -`blink-cursor-suspend'." - (when (and blink-cursor-mode - (not blink-cursor-idle-timer) - (display-graphic-p)) - (remove-hook 'post-command-hook 'blink-cursor-check) - (blink-cursor--start-idle-timer))) +This is done when a frame gets focus. Blink timers may be +stopped by `blink-cursor-suspend'. Internally calls +`blink-cursor--should-blink' and returns its result." + (let ((should-blink (blink-cursor--should-blink ignored-frame))) + (when (and should-blink (not blink-cursor-idle-timer)) + (remove-hook 'post-command-hook 'blink-cursor-check) + (blink-cursor--start-idle-timer)) + should-blink)) + +(defun blink-cursor--rescan-frames (&optional ignored-frame) + "Called when the set of focused frames changes or when we +delete a frame. Re-check whether we want to enable blinking. +IGNORED-FRAME is there so we ignore a frame about to be deleted +when we're called under via `delete-frame-functions'." + (unless (blink-cursor-check ignored-frame) + (blink-cursor-suspend))) (define-minor-mode blink-cursor-mode "Toggle cursor blinking (Blink Cursor mode). @@ -2448,11 +2474,11 @@ terminals, cursor blinking is controlled by the terminal." :group 'cursor :global t (blink-cursor-suspend) - (remove-hook 'focus-in-hook #'blink-cursor-check) - (remove-hook 'focus-out-hook #'blink-cursor-suspend) + (remove-hook 'delete-frame-functions #'blink-cursor--rescan-frames) + (remove-function after-focus-change-function #'blink-cursor--rescan-frames) (when blink-cursor-mode - (add-hook 'focus-in-hook #'blink-cursor-check) - (add-hook 'focus-out-hook #'blink-cursor-suspend) + (add-function :after after-focus-change-function #'blink-cursor--rescan-frames) + (add-hook 'delete-frame-functions #'blink-cursor--rescan-frames) (blink-cursor--start-idle-timer))) commit 6a1dfa713b70861f63def3dbb1d5b1aa6c236e79 Author: Daniel Colascione Date: Mon Jun 11 15:06:51 2018 -0700 Losing focus should not stop idleness * src/keyboard.c (read_char): Make Qfocus_out not break idle. diff --git a/src/keyboard.c b/src/keyboard.c index 84acb24722..0d6a6ad56b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2823,6 +2823,7 @@ read_char (int commandflag, Lisp_Object map, if (CONSP (c) && (EQ (XCAR (c), Qselect_window) + || EQ (XCAR (c), Qfocus_out) #ifdef HAVE_DBUS || EQ (XCAR (c), Qdbus_event) #endif commit 2f6c682061a281dc3e397ff4727a164880e86e7b Author: Daniel Colascione Date: Mon Jun 11 14:58:09 2018 -0700 New focus management interface focus-in-hook and focus-out-hook don't accurately reflect actual user-visible focus states. Add a new focus interface and mark the old one obsolete. * doc/lispref/frames.texi (Input Focus): Document new focus functions. Remove references to the now-obsolete focus hooks. * lisp/frame.el (frame-focus-state): New function. (after-focus-change-function): New variable. (focus-in-hook, focus-out-hook): Move to lisp from C; mark obsolete. * lisp/term/xterm.el (xterm-translate-focus-in) (xterm-translate-focus-out): Track tty focus in `tty-focus-state' terminal parameter; call `after-focus-change-function'. (xterm--suspend-tty-function): New function. * src/frame.c (Fhandle_switch_frame): Update docstring; don't call focus hooks. (focus-in-hook, focus-out-hook): Remove: moved to lisp. (syms_of_frame): Remove unread_switch_frame; add Vunread_switch_frame. * src/keyboard.c: (Finternal_handle_focus_in): New function. (make_lispy_event): Always report focus events to lisp; don't translate them to switch events sometimes. Lisp can take care of creating synthetic switch-frame events via `internal-handle-focus-in'. * src/w32term.c (x_focus_changed): Remove switch-avoidance logic: just directly report focus changes to lisp. * src/xterm.c (x_focus_changed): Remove switch-avoidance logic: just directly report focus changes to lisp. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 459f05cb1c..3a97ec0138 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2702,14 +2702,22 @@ This function returns the selected frame. Some window systems and window managers direct keyboard input to the window object that the mouse is in; others require explicit clicks or commands to @dfn{shift the focus} to various window objects. Either -way, Emacs automatically keeps track of which frame has the focus. To +way, Emacs automatically keeps track of which frames have focus. To explicitly switch to a different frame from a Lisp function, call @code{select-frame-set-input-focus}. -Lisp programs can also switch frames temporarily by calling the -function @code{select-frame}. This does not alter the window system's -concept of focus; rather, it escapes from the window manager's control -until that control is somehow reasserted. +The plural ``frames'' in the previous paragraph is deliberate: while +Emacs itself has only one selected frame, Emacs can have frames on +many different terminals (recall that a connection to a window system +counts as a terminal), and each terminal has its own idea of which +frame has input focus. When you set the input focus to a frame, you +set the focus for that frame's terminal, but frames on other terminals +may still remain focused. + +Lisp programs can switch frames temporarily by calling the function +@code{select-frame}. This does not alter the window system's concept +of focus; rather, it escapes from the window manager's control until +that control is somehow reasserted. When using a text terminal, only one frame can be displayed at a time on the terminal, so after a call to @code{select-frame}, the next @@ -2720,11 +2728,11 @@ before the buffer name (@pxref{Mode Line Variables}). @defun select-frame-set-input-focus frame &optional norecord This function selects @var{frame}, raises it (should it happen to be -obscured by other frames) and tries to give it the X server's focus. -On a text terminal, the next redisplay displays the new frame on the -entire terminal screen. The optional argument @var{norecord} has the -same meaning as for @code{select-frame} (see below). The return value -of this function is not significant. +obscured by other frames) and tries to give it the window system's +focus. On a text terminal, the next redisplay displays the new frame +on the entire terminal screen. The optional argument @var{norecord} +has the same meaning as for @code{select-frame} (see below). +The return value of this function is not significant. @end defun Ideally, the function described next should focus a frame without also @@ -2772,17 +2780,31 @@ could switch to a different terminal without switching back when you're done. @end deffn -Emacs cooperates with the window system by arranging to select frames as -the server and window manager request. It does so by generating a -special kind of input event, called a @dfn{focus} event, when -appropriate. The command loop handles a focus event by calling -@code{handle-switch-frame}. @xref{Focus Events}. +Emacs cooperates with the window system by arranging to select frames +as the server and window manager request. When a window system +informs Emacs that one of its frames has been selected, Emacs +internally generates a @dfn{focus-in} event. Focus events are +normally handled by @code{handle-focus-in}. + +@deffn Command handle-focus-in event +This function handles focus-in events from window systems and +terminals that support explicit focus notifications. It updates the +per-frame focus flags that @code{frame-focus-state} queries and calls +@code{after-focus-change-function}. In addition, it generates a +@code{switch-frame} event in order to switch the Emacs notion of the +selected frame to the frame most recently focused in some terminal. +It's important to note that this switching of the Emacs selected frame +to the most recently focused frame does not mean that other frames do +not continue to have the focus in their respective terminals. Do not +invoke this function yourself: instead, attach logic to +@code{after-focus-change-function}. +@end deffn @deffn Command handle-switch-frame frame -This function handles a focus event by selecting frame @var{frame}. - -Focus events normally do their job by invoking this command. -Don't call it for any other reason. +This function handles a switch-frame event, which Emacs generates for +itself upon focus notification or under various other circumstances +involving an input event arriving at a different frame from the last +event. Do not invoke this function yourself. @end deffn @defun redirect-frame-focus frame &optional focus-frame @@ -2816,14 +2838,42 @@ The redirection lasts until @code{redirect-frame-focus} is called to change it. @end defun -@defvar focus-in-hook -This is a normal hook run when an Emacs frame gains input focus. The -frame gaining focus is selected when this hook is run. -@end defvar +@defun frame-focus-state frame +This function retrieves the last known focus state of @var{frame}. + +It returns @code{nil} if the frame is known not to be focused, +@code{t} if the frame is known to be focused, or @code{unknown} if +Emacs does not know the focus state of the frame. (You may see this +last state in TTY frames running on terminals that do not support +explicit focus notifications.) +@end defun -@defvar focus-out-hook -This is a normal hook run when an Emacs frame has lost input focus and -no other Emacs frame has gained input focus instead. +@defvar after-focus-change-function +This function is an extension point that code can use to receive a +notification that focus has changed. + +This function is called with no arguments when Emacs notices that the +set of focused frames may have changed. Code wanting to do something +when frame focus changes should use @code{add-function} to add a +function to this one, and in this added function, re-scan the set of +focused frames, calling @code{frame-focus-state} to retrieve the last +known focus state of each frame. Focus events are delivered +asynchronously, and frame input focus according to an external system +may not correspond to the notion of the Emacs selected frame. +Multiple frames may appear to have input focus simultaneously due to +focus event delivery differences, the presence of multiple Emacs +terminals, and other factors, and code should be robust in the face of +this situation. + +Depending on window system, focus events may also be delivered +repeatedly and with different focus states before settling to the +expected values. Code relying on focus notifications should +``debounce'' any user-visible updates arising from focus changes, +perhaps by deferring work until redisplay. + +This function may be called in arbitrary contexts, including from +inside @code{read-event}, so take the same care as you might when +writing a process filter. @end defvar @defopt focus-follows-mouse diff --git a/etc/NEWS b/etc/NEWS index 4ea3440754..7b14b9f896 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -582,6 +582,12 @@ manual for more details. * Lisp Changes in Emacs 27.1 ++++ +** New focus state inspection interface: `focus-in-hook' and + `focus-out-hook' are marked obsolete. Instead, attach to + `after-focus-change-function' using `add-function' and inspect the + focus state of each frame using `frame-focus-state'. + +++ ** Emacs now requests and recognizes focus-change notifications from terminals that support the feature, meaning that `focus-in-hook' diff --git a/lisp/frame.el b/lisp/frame.el index c3daff4440..2a2391e8a5 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -129,22 +129,104 @@ appended when the minibuffer frame is created." ;; Gildea@x.org says it is ok to ask questions before terminating. (save-buffers-kill-emacs)))) -(defun handle-focus-in (&optional _event) +(defun frame-focus-state (&optional frame) + "Return FRAME's last known focus state. +Return nil if the frame is definitely known not be focused, t if +the frame is known to be focused, and 'unknown if we don't know. If +FRAME is nil, query the selected frame." + (let* ((frame (or frame (selected-frame))) + (tty-top-frame (tty-top-frame frame))) + (if (not tty-top-frame) + (frame-parameter frame 'last-focus-update) + ;; All tty frames are frame-visible-p if the terminal is + ;; visible, so check whether the frame is the top tty frame + ;; before checking visibility. + (cond ((not (eq tty-top-frame frame)) nil) + ((not (frame-visible-p frame)) nil) + (t (let ((tty-focus-state + (terminal-parameter frame 'tty-focus-state))) + (cond ((eq tty-focus-state 'focused) t) + ((eq tty-focus-state 'defocused) nil) + (t 'unknown)))))))) + +(defvar after-focus-change-function #'ignore + "Function called after frame focus may have changed. + +This function is called with no arguments when Emacs notices that +the set of focused frames may have changed. Code wanting to do +something when frame focus changes should use `add-function' to +add a function to this one, and in this added function, re-scan +the set of focused frames, calling `frame-focus-state' to +retrieve the last known focus state of each frame. Focus events +are delivered asynchronously, and frame input focus according to +an external system may not correspond to the notion of the Emacs +selected frame. Multiple frames may appear to have input focus +simultaneously due to focus event delivery differences, the +presence of multiple Emacs terminals, and other factors, and code +should be robust in the face of this situation. + +Depending on window system, focus events may also be delivered +repeatedly and with different focus states before settling to the +expected values. Code relying on focus notifications should +\"debounce\" any user-visible updates arising from focus changes, +perhaps by deferring work until redisplay. + +This function may be called in arbitrary contexts, including from +inside `read-event', so take the same care as you might when +writing a process filter.") + +(defvar focus-in-hook nil + "Normal hook run when a frame gains focus. +The frame gaining focus is selected at the time this hook is run. + +This hook is obsolete. Despite its name, this hook may be run in +situations other than when a frame obtains input focus: for +example, we also run this hook when switching the selected frame +internally to handle certain input events (like mouse wheel +scrolling) even when the user's notion of input focus +hasn't changed. + +Prefer using `after-focus-change-function'.") +(make-obsolete-variable + 'focus-in-hook "after-focus-change-function" "27.1" 'set) + +(defvar focus-out-hook nil + "Normal hook run when all frames lost input focus. + +This hook is obsolete; see `focus-in-hook'. Depending on timing, +this hook may be delivered when a frame does in fact have focus. +Prefer `after-focus-change-function'.") +(make-obsolete-variable + 'focus-out-hook "after-focus-change-function" "27.1" 'set) + +(defun handle-focus-in (event) "Handle a focus-in event. -Focus-in events are usually bound to this function. -Focus-in events occur when a frame has focus, but a switch-frame event -is not generated. -This function runs the hook `focus-in-hook'." +Focus-in events are bound to this function; do not change this +binding. Focus-in events occur when a frame receives focus from +the window system." + ;; N.B. tty focus goes down a different path; see xterm.el. (interactive "e") - (run-hooks 'focus-in-hook)) - -(defun handle-focus-out (&optional _event) + (unless (eq (car-safe event) 'focus-in) + (error "handle-focus-in should handle focus-in events")) + (internal-handle-focus-in event) + (let ((frame (nth 1 event))) + (setf (frame-parameter frame 'last-focus-update) t) + (run-hooks 'focus-in-hook) + (funcall after-focus-change-function))) + +(defun handle-focus-out (event) "Handle a focus-out event. -Focus-out events are usually bound to this function. -Focus-out events occur when no frame has focus. -This function runs the hook `focus-out-hook'." +Focus-out events are bound to this function; do not change this +binding. Focus-out events occur when a frame loses focus, but +that's not the whole story: see `after-focus-change-function'." + ;; N.B. tty focus goes down a different path; see xterm.el. (interactive "e") - (run-hooks 'focus-out-hook)) + (unless (eq (car event) 'focus-out) + (error "handle-focus-out should handle focus-out events")) + (let ((frame (nth 1 event))) + (setf (frame-parameter frame 'last-focus-update) nil) + (run-hooks 'focus-out-hook) + (funcall after-focus-change-function))) (defun handle-move-frame (event) "Handle a move-frame event. diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index b3b7a21635..ce4e18efff 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -115,13 +115,20 @@ Return the pasted text as a string." ;; notifications) instead of read-event (which can't). (defun xterm-translate-focus-in (_prompt) - (handle-focus-in) + (setf (terminal-parameter nil 'tty-focus-state) 'focused) + (funcall after-focus-change-function) []) (defun xterm-translate-focus-out (_prompt) - (handle-focus-out) + (setf (terminal-parameter nil 'tty-focus-state) 'defocused) + (funcall after-focus-change-function) []) +(defun xterm--suspend-tty-function (_tty) + ;; We can't know what happens to the tty after we're suspended + (setf (terminal-parameter nil 'tty-focus-state) nil) + (funcall after-focus-change-function)) + ;; Similarly, we want to transparently slurp the entirety of a ;; bracketed paste and encapsulate it into a single event. We used to ;; just slurp up the bracketed paste content in the event handler, but diff --git a/src/frame.c b/src/frame.c index da82621b8a..bf0269292d 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1455,23 +1455,15 @@ This function returns FRAME, or nil if FRAME has been deleted. */) DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "^e", doc: /* Handle a switch-frame event EVENT. Switch-frame events are usually bound to this function. -A switch-frame event tells Emacs that the window manager has requested -that the user's events be directed to the frame mentioned in the event. -This function selects the selected window of the frame of EVENT. - -If EVENT is frame object, handle it as if it were a switch-frame event -to that frame. */) +A switch-frame event is an event Emacs sends itself to +indicate that input is arriving in a new frame. It does not +necessarily represent user-visible input focus. */) (Lisp_Object event) { - Lisp_Object value; - /* Preserve prefix arg that the command loop just cleared. */ kset_prefix_arg (current_kboard, Vcurrent_prefix_arg); run_hook (Qmouse_leave_buffer_hook); - /* `switch-frame' implies a focus in. */ - value = do_switch_frame (event, 0, 0, Qnil); - call1 (intern ("handle-focus-in"), event); - return value; + return do_switch_frame (event, 0, 0, Qnil); } DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, @@ -5888,15 +5880,6 @@ when the mouse is over clickable text. */); The pointer becomes visible again when the mouse is moved. */); Vmake_pointer_invisible = Qt; - DEFVAR_LISP ("focus-in-hook", Vfocus_in_hook, - doc: /* Normal hook run when a frame gains input focus. -The frame gaining focus is selected at the time this hook is run. */); - Vfocus_in_hook = Qnil; - - DEFVAR_LISP ("focus-out-hook", Vfocus_out_hook, - doc: /* Normal hook run when all frames lost input focus. */); - Vfocus_out_hook = Qnil; - DEFVAR_LISP ("move-frame-functions", Vmove_frame_functions, doc: /* Functions run after a frame was moved. The functions are run with one arg, the frame that moved. */); diff --git a/src/keyboard.c b/src/keyboard.c index c9e069c865..84acb24722 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5331,45 +5331,10 @@ make_lispy_event (struct input_event *event) } case FOCUS_IN_EVENT: - { - /* Notification of a FocusIn event. The frame receiving the - focus is in event->frame_or_window. Generate a - switch-frame event if necessary. */ - - Lisp_Object frame = event->frame_or_window; - Lisp_Object focus = FRAME_FOCUS_FRAME (XFRAME (frame)); - if (FRAMEP (focus)) - frame = focus; - bool switching - = ( -#ifdef HAVE_X11 - ! NILP (event->arg) - && -#endif - !EQ (frame, internal_last_event_frame) - && !EQ (frame, selected_frame)); - internal_last_event_frame = frame; - - return (switching ? make_lispy_switch_frame (frame) - : make_lispy_focus_in (frame)); - } + return make_lispy_focus_in (event->frame_or_window); case FOCUS_OUT_EVENT: - { -#ifdef HAVE_WINDOW_SYSTEM - - Display_Info *di; - Lisp_Object frame = event->frame_or_window; - bool focused = false; - - for (di = x_display_list; di && ! focused; di = di->next) - focused = di->x_highlight_frame != 0; - - return focused ? Qnil - : make_lispy_focus_out (frame); - -#endif /* HAVE_WINDOW_SYSTEM */ - } + return make_lispy_focus_out (event->frame_or_window); /* A simple keystroke. */ case ASCII_KEYSTROKE_EVENT: @@ -6637,6 +6602,31 @@ has the same base event type and all the specified modifiers. */) error ("Invalid base event"); } +DEFUN ("internal-handle-focus-in", Finternal_handle_focus_in, + Sinternal_handle_focus_in, 1, 1, 0, + doc: /* Internally handle focus-in events, possibly generating +an artifical switch-frame event. */) + (Lisp_Object event) +{ + Lisp_Object frame; + if (!EQ (CAR_SAFE (event), Qfocus_in) || + !CONSP (XCDR (event)) || + !FRAMEP ((frame = XCAR (XCDR (event))))) + error ("invalid focus-in event"); + + /* Conceptually, the concept of window manager focus on a particular + frame and the Emacs selected frame shouldn't be related, but for a + long time, we automatically switched the selected frame in response + to focus events, so let's keep doing that. */ + bool switching = (!EQ (frame, internal_last_event_frame) + && !EQ (frame, selected_frame)); + internal_last_event_frame = frame; + if (switching || !NILP (unread_switch_frame)) + unread_switch_frame = make_lispy_switch_frame (frame); + + return Qnil; +} + /* Try to recognize SYMBOL as a modifier name. Return the modifier flag bit, or 0 if not recognized. */ @@ -11277,6 +11267,7 @@ syms_of_keyboard (void) defsubr (&Scurrent_idle_time); defsubr (&Sevent_symbol_parse_modifiers); defsubr (&Sevent_convert_list); + defsubr (&Sinternal_handle_focus_in); defsubr (&Sread_key_sequence); defsubr (&Sread_key_sequence_vector); defsubr (&Srecursive_edit); diff --git a/src/w32term.c b/src/w32term.c index 24950dd25e..ff0d2bf5dd 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -2886,20 +2886,6 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo, { x_new_focus_frame (dpyinfo, frame); dpyinfo->w32_focus_event_frame = frame; - - /* Don't stop displaying the initial startup message - for a switch-frame event we don't need. */ - if (NILP (Vterminal_frame) - && CONSP (Vframe_list) - && !NILP (XCDR (Vframe_list))) - { - bufp->arg = Qt; - } - else - { - bufp->arg = Qnil; - } - bufp->kind = FOCUS_IN_EVENT; XSETFRAME (bufp->frame_or_window, frame); } diff --git a/src/xterm.c b/src/xterm.c index eb299c3675..decaa33670 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4387,16 +4387,6 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra { x_new_focus_frame (dpyinfo, frame); dpyinfo->x_focus_event_frame = frame; - - /* Don't stop displaying the initial startup message - for a switch-frame event we don't need. */ - /* When run as a daemon, Vterminal_frame is always NIL. */ - bufp->arg = (((NILP (Vterminal_frame) - || ! FRAME_X_P (XFRAME (Vterminal_frame)) - || EQ (Fdaemonp (), Qt)) - && CONSP (Vframe_list) - && !NILP (XCDR (Vframe_list))) - ? Qt : Qnil); bufp->kind = FOCUS_IN_EVENT; XSETFRAME (bufp->frame_or_window, frame); } commit a20fe5a7e3577f9b9ad5e88006962966240d9b0c Author: Daniel Colascione Date: Sat Jun 9 23:45:48 2018 -0700 Remove code #if-0-ed terminal-local code This code hasn't been used since 2005. * src/data.c (get_terminal, Fterminal_local_value, Fset_terminal_local_value): Remove. diff --git a/src/data.c b/src/data.c index 6f23a26757..49c3dd834b 100644 --- a/src/data.c +++ b/src/data.c @@ -2153,47 +2153,6 @@ If the current binding is global (the default), the value is nil. */) } } -/* This code is disabled now that we use the selected frame to return - keyboard-local-values. */ -#if 0 -extern struct terminal *get_terminal (Lisp_Object display, int); - -DEFUN ("terminal-local-value", Fterminal_local_value, - Sterminal_local_value, 2, 2, 0, - doc: /* Return the terminal-local value of SYMBOL on TERMINAL. -If SYMBOL is not a terminal-local variable, then return its normal -value, like `symbol-value'. - -TERMINAL may be a terminal object, a frame, or nil (meaning the -selected frame's terminal device). */) - (Lisp_Object symbol, Lisp_Object terminal) -{ - Lisp_Object result; - struct terminal *t = get_terminal (terminal, 1); - push_kboard (t->kboard); - result = Fsymbol_value (symbol); - pop_kboard (); - return result; -} - -DEFUN ("set-terminal-local-value", Fset_terminal_local_value, - Sset_terminal_local_value, 3, 3, 0, - doc: /* Set the terminal-local binding of SYMBOL on TERMINAL to VALUE. -If VARIABLE is not a terminal-local variable, then set its normal -binding, like `set'. - -TERMINAL may be a terminal object, a frame, or nil (meaning the -selected frame's terminal device). */) - (Lisp_Object symbol, Lisp_Object terminal, Lisp_Object value) -{ - Lisp_Object result; - struct terminal *t = get_terminal (terminal, 1); - push_kboard (d->kboard); - result = Fset (symbol, value); - pop_kboard (); - return result; -} -#endif /* Find the function at the end of a chain of symbol function indirections. */ @@ -3827,10 +3786,6 @@ syms_of_data (void) defsubr (&Slocal_variable_p); defsubr (&Slocal_variable_if_set_p); defsubr (&Svariable_binding_locus); -#if 0 /* XXX Remove this. --lorentey */ - defsubr (&Sterminal_local_value); - defsubr (&Sset_terminal_local_value); -#endif defsubr (&Saref); defsubr (&Saset); defsubr (&Snumber_to_string); commit b4e953ba0442e351ef06b93e85fbe67bbf163771 Author: Daniel Colascione Date: Sat Jun 9 18:30:28 2018 -0700 Remove obsolete keyboard.c code * src/keyboard.c (any_kboard_state, single_kboard_state): Remove #if-0-ed functions. diff --git a/src/keyboard.c b/src/keyboard.c index c90fbd302f..c9e069c865 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -788,35 +788,6 @@ recursive_edit_unwind (Lisp_Object buffer) } -#if 0 /* These two functions are now replaced with - temporarily_switch_to_single_kboard. */ -static void -any_kboard_state () -{ -#if 0 /* Theory: if there's anything in Vunread_command_events, - it will right away be read by read_key_sequence, - and then if we do switch KBOARDS, it will go into the side - queue then. So we don't need to do anything special here -- rms. */ - if (CONSP (Vunread_command_events)) - { - current_kboard->kbd_queue - = nconc2 (Vunread_command_events, current_kboard->kbd_queue); - current_kboard->kbd_queue_has_data = true; - } - Vunread_command_events = Qnil; -#endif - single_kboard = false; -} - -/* Switch to the single-kboard state, making current_kboard - the only KBOARD from which further input is accepted. */ - -void -single_kboard_state () -{ - single_kboard = true; -} -#endif /* If we're in single_kboard state for kboard KBOARD, get out of it. */ @@ -915,16 +886,6 @@ temporarily_switch_to_single_kboard (struct frame *f) record_unwind_protect_int (restore_kboard_configuration, was_locked); } -#if 0 /* This function is not needed anymore. */ -void -record_single_kboard_state () -{ - if (single_kboard) - push_kboard (current_kboard); - record_unwind_protect_int (restore_kboard_configuration, single_kboard); -} -#endif - static void restore_kboard_configuration (int was_locked) { commit 94d60f59fc654706c3a52ed2c90c355b36be7898 Author: Lars Ingebrigtsen Date: Mon Jun 11 20:38:25 2018 +0200 Don't have shr bug out on degenerate tags * lisp/net/shr.el (shr-tag-img): Protect against contructs like . diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 1103a93024..edea7cb297 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1560,6 +1560,10 @@ The preference is a float determined from `shr-prefer-media-type'." (when (zerop (length alt)) (setq alt "*")) (cond + ((null url) + ;; After further expansion, there turned out to be no valid + ;; src in the img after all. + ) ((or (member (dom-attr dom 'height) '("0" "1")) (member (dom-attr dom 'width) '("0" "1"))) ;; Ignore zero-sized or single-pixel images.