diff options
| -rw-r--r-- | README.org | 52 | ||||
| -rw-r--r-- | assets/geolocation.png | bin | 0 -> 54352 bytes | |||
| -rw-r--r-- | assets/location-menu.png | bin | 40165 -> 52575 bytes | |||
| -rw-r--r-- | assets/wttrin.png | bin | 187797 -> 353589 bytes | |||
| -rw-r--r-- | tests/test-wttrin--add-buffer-instructions.el | 34 | ||||
| -rw-r--r-- | tests/test-wttrin--display-weather.el | 15 | ||||
| -rw-r--r-- | tests/test-wttrin--mode-line-update-display.el | 24 | ||||
| -rw-r--r-- | tests/test-wttrin-geolocation-sentinel.el | 4 | ||||
| -rw-r--r-- | tests/test-wttrin-requery-force.el | 6 | ||||
| -rw-r--r-- | tests/test-wttrin-requery.el | 14 | ||||
| -rw-r--r-- | tests/test-wttrin-saved-locations.el | 360 | ||||
| -rw-r--r-- | tests/test-wttrin-set-location-from-geolocation.el | 23 | ||||
| -rw-r--r-- | tests/test-wttrin-use-current-location.el | 21 | ||||
| -rw-r--r-- | wttrin.el | 483 |
14 files changed, 884 insertions, 152 deletions
@@ -106,9 +106,9 @@ Simply use the keybinding you assigned, or run `M-x wttrin` to display the weath [[assets/location-menu.png]] -Choose one, or for a quick one-time weather check, type a new location and ⏎ . After the weather is displayed, you can press `a` to check another location, `g` to refresh, `d` to make the shown location your default, or `q` to quit. +Choose one, or for a quick one-time weather check, type a new location and ⏎ . After the weather is displayed, the footer shows two groups of keys. Keys that act on the view: `a` for another location, `g` to refresh, `q` to quit. Keys that act on your saved locations: `s` to save the shown location, `d` to make it your default, `r` to rename a saved location, and `x` to remove one. -Pressing `d` sets =wttrin-favorite-location= to the location on screen and remembers it across restarts (via savehist), so the mode-line and future sessions follow it. Your default is also offered in the location list the next time you run =M-x wttrin=. Enable =savehist-mode= for the persistence to stick. +Pressing `d` sets =wttrin-favorite-location= to the location on screen and remembers it across restarts (via savehist), so the mode-line and future sessions follow it. Your default is also offered in the location list the next time you run =M-x wttrin=. Enable =savehist-mode= for the persistence to stick. (On a geolocation-detected buffer, `d` first prompts for a name and saves it — see Naming Locations.) If you're looking at cached data, a line below the weather art tells you how old it is (e.g., "Last updated: 2:30 PM (5 minutes ago)"). @@ -133,7 +133,7 @@ Most people will just want to add a bunch of cities to the location list. Howeve *** Location Search History -Locations you search successfully are remembered and offered as completion candidates the next time you run =M-x wttrin=, listed after your configured defaults. Only successful lookups are saved, so typos and not-found locations never enter the history. A location already in =wttrin-default-locations= is not duplicated into the history. +Locations you search successfully are remembered and offered as completion candidates the next time you run =M-x wttrin=, after your saved and default locations. Only successful lookups are saved, so typos and not-found locations never enter the history. Entries already offered elsewhere are not duplicated into the history: defaults, saved-location names (see Naming Locations), and raw =lat,lng= coordinates from geolocation are all kept out. History is capped at =wttrin-location-history-max= entries (default 20); the oldest fall off as new ones arrive. @@ -305,6 +305,10 @@ The command runs asynchronously and must print a JSON object with numeric =lat= wttrin queries wttr.in by the coordinates and lets it echo the place name in its own header. A command that scans nearby WiFi access points and looks them up (far more accurate than IP) is the typical source. The package ships no command and assumes nothing about your system, so this is inert until you set it. If the command is unset, exits non-zero, or prints no usable coordinates, wttrin falls back to the IP provider above. +The resolved coordinates show in the header, with the readable place on the "Location:" line below: + +[[assets/geolocation.png]] + Two ready-to-adapt example commands live in [[file:examples/geolocation/][examples/geolocation/]]: =google-geolocate.py= (Google Geolocation API, needs a key) and =apple-wps.py= (Apple's keyless WiFi positioning, which uses an undocumented endpoint — read its caveat). Both are Python 3 standard library, scan WiFi via =nmcli=, and print the JSON described above. See that directory's README for setup. The older =M-x wttrin-set-location-from-geolocation= command still works but is deprecated in favor of the picker entry above. @@ -315,15 +319,45 @@ The older =M-x wttrin-set-location-from-geolocation= command still works but is (setq wttrin-geolocation-enabled nil) #+end_src +*** Naming Locations +A saved location has a friendly name and a separate query: =wttrin= shows the name in the picker, the buffer header, and the mode-line, but fetches weather for the query. That lets a precise query hide behind a readable name — "Craig's House" rather than "1500 Sugar Bowl Dr, New Orleans". The query can be a city, a full address, or =lat,lng= coordinates. + +Set them in your init: + +#+begin_src emacs-lisp + (setq wttrin-saved-locations + '(("Craig's House" . "1500 Sugar Bowl Dr, New Orleans") + ("Home" . "41.37,-71.83"))) +#+end_src + +Or build the directory interactively: + +- =M-x wttrin-save-location= — save the place in the current weather buffer (or a typed query) under a name. Saving an existing name updates its query. +- =M-x wttrin-rename-location= — rename an entry (refused if the new name is already taken). +- =M-x wttrin-remove-location= — remove an entry (asks to confirm). + +The directory persists across sessions with =savehist-mode= on (=wttrin= registers it), the same as your favorite and history. + +You can point =wttrin-favorite-location= at a saved name (e.g. ="Craig's House"=): the mode-line resolves it to the query for fetching but shows the name in the tooltip. + +When you pick "Current location (detect)" and press =d= to keep it, =wttrin= prompts for a name (prefilled with the detected address) and saves it as a named location, then makes it your default. Clear the field and press RET to keep the raw coordinates instead. Raw coordinates never clutter your history; only named places are remembered. + +*Privacy:* a saved query can be a home or work street address, kept in plaintext in your savehist file. With =wttrin-debug= on, the query and raw responses are also written to the debug log. =wttrin= does not encrypt or redact these, so save what you're comfortable storing in plain text. + *** Theming the Faces The text wttrin draws itself uses named faces, so themes and =M-x customize-face= can restyle it. (The weather art itself is colored by the ANSI codes wttr.in returns, not by these faces.) -| Face | Styles | Default | -|---------------------------+------------------------------------------------------+-------------------| -| =wttrin-mode-line-stale= | the mode-line emoji when its data has gone stale | inherits =shadow= | -| =wttrin-staleness-header= | the "Last updated: ..." line in the weather buffer | inherits =shadow= | -| =wttrin-instructions= | the key-hint footer prose in the weather buffer | inherits =shadow= | -| =wttrin-key= | the bracketed key chords ([a] [g] [q]) in the footer | inherits =bold= | +| Face | Styles | Default | +|------------------------------+--------------------------------------------+--------------------------| +| =wttrin-mode-line-stale= | the mode-line emoji when its data is stale | inherits =shadow= | +|------------------------------+--------------------------------------------+--------------------------| +| =wttrin-staleness-header= | the "Last updated:" and "Location:" lines | inherits =shadow= | +|------------------------------+--------------------------------------------+--------------------------| +| =wttrin-instructions= | the footer key labels | inherits =shadow= | +|------------------------------+--------------------------------------------+--------------------------| +| =wttrin-instructions-header= | the footer column headers | inherits =(bold shadow)= | +|------------------------------+--------------------------------------------+--------------------------| +| =wttrin-key= | the bracketed key chords ([a] [g] [q]) | inherits =bold= | Restyle them in your init file like any other face: diff --git a/assets/geolocation.png b/assets/geolocation.png Binary files differnew file mode 100644 index 0000000..836c864 --- /dev/null +++ b/assets/geolocation.png diff --git a/assets/location-menu.png b/assets/location-menu.png Binary files differindex 2421ae9..791f63c 100644 --- a/assets/location-menu.png +++ b/assets/location-menu.png diff --git a/assets/wttrin.png b/assets/wttrin.png Binary files differindex a81b4a5..8776c76 100644 --- a/assets/wttrin.png +++ b/assets/wttrin.png diff --git a/tests/test-wttrin--add-buffer-instructions.el b/tests/test-wttrin--add-buffer-instructions.el index 425832d..fdd7c91 100644 --- a/tests/test-wttrin--add-buffer-instructions.el +++ b/tests/test-wttrin--add-buffer-instructions.el @@ -14,6 +14,17 @@ ;;; Setup and Teardown +(defun test-wttrin--expected-footer () + "Return the footer string `wttrin--add-buffer-instructions' should produce. +Width 23 is pinned here as a literal, independent of the production +constant, so the test fails if the visible layout drifts." + (concat "\n\n" + (format "%-23s%s" "This view" "Saved locations") "\n" + (format "%-23s%s" "[a] another" "[s] save") "\n" + (format "%-23s%s" "[g] refresh" "[d] make default") "\n" + (format "%-23s%s" "[q] quit" "[r] rename") "\n" + (format "%-23s%s" "" "[x] remove"))) + (defun test-wttrin--add-buffer-instructions-setup () "Setup for add-buffer-instructions tests." (testutil-wttrin-setup)) @@ -28,7 +39,7 @@ "Test adding instructions to empty buffer." (with-temp-buffer (wttrin--add-buffer-instructions) - (should (string= "\n\nPress: [a] for another location [g] to refresh [d] to make default [q] to quit" + (should (string= (test-wttrin--expected-footer) (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-normal-with-existing-content-appends-instructions () @@ -36,7 +47,8 @@ (with-temp-buffer (insert "Weather: Sunny\nTemperature: 20°C") (wttrin--add-buffer-instructions) - (should (string= "Weather: Sunny\nTemperature: 20°C\n\nPress: [a] for another location [g] to refresh [d] to make default [q] to quit" + (should (string= (concat "Weather: Sunny\nTemperature: 20°C" + (test-wttrin--expected-footer)) (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-normal-preserves-point-moves-to-end () @@ -56,12 +68,12 @@ (wttrin--add-buffer-instructions) ;; Should add instructions again, not check if they already exist (should-not (string= first-result (buffer-string))) - ;; Check for two occurrences of "Press:" by counting matches + ;; Check for two occurrences of the header by counting matches (let ((count 0)) (with-temp-buffer (insert first-result) (goto-char (point-min)) - (while (search-forward "Press:" nil t) + (while (search-forward "This view" nil t) (setq count (1+ count)))) ;; After first call, should have 1 occurrence (should (= 1 count))) @@ -69,7 +81,7 @@ (let ((count 0)) (save-excursion (goto-char (point-min)) - (while (search-forward "Press:" nil t) + (while (search-forward "This view" nil t) (setq count (1+ count)))) (should (= 2 count)))))) @@ -88,7 +100,7 @@ (with-temp-buffer (wttrin--add-buffer-instructions) (goto-char (point-min)) - (search-forward "Press:") + (search-forward "another") (should (eq (get-text-property (1- (point)) 'face) 'wttrin-instructions)))) ;;; Boundary Cases @@ -99,7 +111,7 @@ (insert "Weather data here") (goto-char (point-min)) (wttrin--add-buffer-instructions) - (should (string-suffix-p "Press: [a] for another location [g] to refresh [d] to make default [q] to quit" + (should (string-suffix-p "[x] remove" (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-point-in-middle-appends-at-end () @@ -109,7 +121,7 @@ (goto-char (point-min)) (forward-line 1) (wttrin--add-buffer-instructions) - (should (string-suffix-p "Press: [a] for another location [g] to refresh [d] to make default [q] to quit" + (should (string-suffix-p "[x] remove" (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-trailing-newlines-preserves-newlines () @@ -117,7 +129,7 @@ (with-temp-buffer (insert "Weather\n\n\n") (wttrin--add-buffer-instructions) - (should (string= "Weather\n\n\n\n\nPress: [a] for another location [g] to refresh [d] to make default [q] to quit" + (should (string= (concat "Weather\n\n\n" (test-wttrin--expected-footer)) (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-very-large-buffer-appends-at-end () @@ -126,7 +138,7 @@ (insert (make-string 10000 ?x)) (wttrin--add-buffer-instructions) (goto-char (point-max)) - (should (looking-back "Press: \\[a\\] for another location \\[g\\] to refresh \\[d\\] to make default \\[q\\] to quit" nil)))) + (should (looking-back "\\[x\\] remove" nil)))) ;;; Error Cases @@ -152,7 +164,7 @@ (widen) (goto-char start) (forward-line 1) - (should (looking-at-p "\n\nPress:"))))) + (should (looking-at-p "\n\nThis view"))))) (provide 'test-wttrin--add-buffer-instructions) ;;; test-wttrin--add-buffer-instructions.el ends here diff --git a/tests/test-wttrin--display-weather.el b/tests/test-wttrin--display-weather.el index 4cc4269..99ea067 100644 --- a/tests/test-wttrin--display-weather.el +++ b/tests/test-wttrin--display-weather.el @@ -97,13 +97,14 @@ Weather report: Paris, France (wttrin--display-weather "Tokyo" test-wttrin--display-weather-sample-raw-data) (with-current-buffer "*wttr.in*" - (goto-char (point-max)) - (forward-line -2) - ;; Should contain help text - (should (search-forward "Press:" nil t)) - (should (search-forward "[a] for another location" nil t)) - (should (search-forward "[g] to refresh" nil t)) - (should (search-forward "[q] to quit" nil t)))) + ;; The two-column footer carries both groups; check a token from + ;; each column independently (document order mixes them). + (let ((text (buffer-string))) + (should (string-match-p "This view" text)) + (should (string-match-p "Saved locations" text)) + (should (string-match-p "\\[a\\] another" text)) + (should (string-match-p "\\[s\\] save" text)) + (should (string-match-p "\\[x\\] remove" text))))) (test-wttrin--display-weather-teardown))) ;;; Boundary Cases diff --git a/tests/test-wttrin--mode-line-update-display.el b/tests/test-wttrin--mode-line-update-display.el index 721517e..be066e7 100644 --- a/tests/test-wttrin--mode-line-update-display.el +++ b/tests/test-wttrin--mode-line-update-display.el @@ -252,6 +252,30 @@ trigger an emoji re-render so dimming matches the tooltip's staleness state." (should wttrin-mode-line-string))) (test-wttrin--mode-line-update-display-teardown))) +(ert-deftest test-wttrin--mode-line-fetch-weather-normal-saved-name-shown-in-cache () + "Normal: a saved-name favorite caches its display name, not the resolved query. +The query (coordinates or an address) drives the fetch, but the hover tooltip +should read the friendly name the user gave the place." + (test-wttrin--mode-line-update-display-setup) + (unwind-protect + (let ((wttrin-saved-locations '(("Mom's House" . "40.71,-74.01"))) + (wttrin-favorite-location "Mom's House")) + (testutil-wttrin-mock-http-response "40.71,-74.01: ☀️ +70°F Cloudy" + (wttrin--mode-line-fetch-weather) + (should (string-prefix-p "Mom's House:" (cdr wttrin--mode-line-cache))))) + (test-wttrin--mode-line-update-display-teardown))) + +(ert-deftest test-wttrin--mode-line-fetch-weather-boundary-plain-location-unchanged () + "Boundary: a plain (non-saved) favorite still caches its own name as the prefix." + (test-wttrin--mode-line-update-display-setup) + (unwind-protect + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location "Paris")) + (testutil-wttrin-mock-http-response "Paris: ☀️ +61°F Clear" + (wttrin--mode-line-fetch-weather) + (should (string-prefix-p "Paris:" (cdr wttrin--mode-line-cache))))) + (test-wttrin--mode-line-update-display-teardown))) + (ert-deftest test-wttrin--mode-line-fetch-weather-error-empty-response-keeps-previous () "Empty API response does not overwrite previous valid cache." (test-wttrin--mode-line-update-display-setup) diff --git a/tests/test-wttrin-geolocation-sentinel.el b/tests/test-wttrin-geolocation-sentinel.el index 61d8997..169761b 100644 --- a/tests/test-wttrin-geolocation-sentinel.el +++ b/tests/test-wttrin-geolocation-sentinel.el @@ -102,7 +102,7 @@ through `wttrin--query-selection' (smoke test of the entry wrapper)." (unwind-protect (let ((captured nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq captured loc)))) + (lambda (loc &rest _) (setq captured loc)))) (wttrin--query-selection "Paris")) (should (equal "Paris" captured))) (testutil-wttrin-teardown))) @@ -115,7 +115,7 @@ through `wttrin--query-selection' (smoke test of the entry wrapper)." (cl-letf (((symbol-function 'wttrin-geolocation-detect) (lambda (callback) (funcall callback "Austin, TX"))) ((symbol-function 'wttrin-query) - (lambda (loc &optional _address) (setq captured loc))) + (lambda (loc &rest _) (setq captured loc))) ((symbol-function 'message) (lambda (&rest _) nil))) (wttrin--query-selection wttrin--geolocation-sentinel)) (should (equal "Austin, TX" captured))) diff --git a/tests/test-wttrin-requery-force.el b/tests/test-wttrin-requery-force.el index 171166d..30af7dd 100644 --- a/tests/test-wttrin-requery-force.el +++ b/tests/test-wttrin-requery-force.el @@ -35,7 +35,7 @@ (unwind-protect (let ((queried-location nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (location) (setq queried-location location)))) + (lambda (location &rest _) (setq queried-location location)))) ;; Set up a weather buffer with a known location (with-current-buffer (get-buffer-create "*wttr.in*") (setq-local wttrin--current-location "Berlin, DE") @@ -49,7 +49,7 @@ (unwind-protect (let ((force-refresh-was-set nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (_location) + (lambda (_location &rest _) (setq force-refresh-was-set wttrin--force-refresh)))) (with-current-buffer (get-buffer-create "*wttr.in*") (setq-local wttrin--current-location "Paris") @@ -76,7 +76,7 @@ (test-wttrin-requery-force-setup) (unwind-protect (progn - (cl-letf (((symbol-function 'wttrin-query) (lambda (_location) nil))) + (cl-letf (((symbol-function 'wttrin-query) (lambda (_location &rest _) nil))) (with-current-buffer (get-buffer-create "*wttr.in*") (setq-local wttrin--current-location "Paris") (wttrin-requery-force))) diff --git a/tests/test-wttrin-requery.el b/tests/test-wttrin-requery.el index 5d52b36..e065c43 100644 --- a/tests/test-wttrin-requery.el +++ b/tests/test-wttrin-requery.el @@ -39,7 +39,7 @@ (test-wttrin-requery-setup) (unwind-protect (let ((old-buffer (get-buffer-create "*wttr.in*"))) - (cl-letf (((symbol-function 'wttrin-query) (lambda (_loc) nil))) + (cl-letf (((symbol-function 'wttrin-query) (lambda (_loc &rest _) nil))) (wttrin--requery-location "Tokyo") ;; Old buffer should be dead (should-not (buffer-live-p old-buffer)))) @@ -51,7 +51,7 @@ (unwind-protect (let ((queried-location nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq queried-location loc)))) + (lambda (loc &rest _) (setq queried-location loc)))) (wttrin--requery-location "Berlin, DE") (should (equal queried-location "Berlin, DE")))) (test-wttrin-requery-teardown))) @@ -66,7 +66,7 @@ ;; Ensure no buffer exists (should-not (get-buffer "*wttr.in*")) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq queried-location loc)))) + (lambda (loc &rest _) (setq queried-location loc)))) (wttrin--requery-location "Paris") (should (equal queried-location "Paris")))) (test-wttrin-requery-teardown))) @@ -77,7 +77,7 @@ (unwind-protect (let ((queried-location nil)) (cl-letf (((symbol-function 'wttrin-query) - (lambda (loc) (setq queried-location loc)))) + (lambda (loc &rest _) (setq queried-location loc)))) (wttrin--requery-location "Zürich, CH") (should (equal queried-location "Zürich, CH")))) (test-wttrin-requery-teardown))) @@ -113,7 +113,7 @@ to the core requery function." (setq offered-collection collection) "Paris")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) ;; The collection is now a completion table (a function) that pins ;; the sentinel first; check the candidates it completes over. @@ -134,7 +134,7 @@ to the core requery function." (setq initial-input init) "Solo City")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) (should (equal initial-input "Solo City")))) (test-wttrin-requery-teardown))) @@ -150,7 +150,7 @@ to the core requery function." (setq initial-input init) "Paris")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) (should-not initial-input))) (test-wttrin-requery-teardown))) diff --git a/tests/test-wttrin-saved-locations.el b/tests/test-wttrin-saved-locations.el new file mode 100644 index 0000000..0a7b8b3 --- /dev/null +++ b/tests/test-wttrin-saved-locations.el @@ -0,0 +1,360 @@ +;;; test-wttrin-saved-locations.el --- Tests for the named-locations directory -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the named-locations directory (Phase 1): the normalizer +;; `wttrin--saved-locations', the resolver `wttrin--resolve-location-query', +;; candidate de-duplication/precedence, favorite-as-name resolution, alias cache +;; identity, history suppression of saved names, and savehist registration. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; wttrin--saved-locations (normalizer) + +(ert-deftest test-wttrin-saved-locations-normal-pairs-returned () + "Normal: well-formed pairs are returned as (NAME . QUERY)." + (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans")))) + (should (equal '(("Home" . "1500 Sugar Bowl Dr, New Orleans")) + (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-bare-string-shorthand () + "Boundary: a bare string S becomes (S . S)." + (let ((wttrin-saved-locations '("Berkeley, CA"))) + (should (equal '(("Berkeley, CA" . "Berkeley, CA")) + (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-whitespace-trimmed () + "Boundary: surrounding whitespace on name and query is trimmed." + (let ((wttrin-saved-locations '((" Home " . " Paris, FR ")))) + (should (equal '(("Home" . "Paris, FR")) (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-error-malformed-skipped () + "Error: non-cons, non-string, and empty entries are skipped, not fatal." + (let ((wttrin-saved-locations + (list '("Good" . "Tokyo") 42 '("" . "x") '("y" . "") " " '(a . b)))) + (should (equal '(("Good" . "Tokyo")) (wttrin--saved-locations))))) + +;;; wttrin--resolve-location-query + +(ert-deftest test-wttrin-saved-locations-normal-resolve-name-to-query () + "Normal: a saved name resolves to its query." + (let ((wttrin-saved-locations '(("Craig's House" . "1500 Sugar Bowl Dr, New Orleans")))) + (should (equal "1500 Sugar Bowl Dr, New Orleans" + (wttrin--resolve-location-query "Craig's House"))))) + +(ert-deftest test-wttrin-saved-locations-boundary-resolve-passthrough () + "Boundary: a non-saved selection passes through unchanged." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (should (equal "Tokyo, JP" (wttrin--resolve-location-query "Tokyo, JP"))))) + +;;; Candidate de-duplication and precedence + +(ert-deftest test-wttrin-saved-locations-normal-candidates-precedence () + "Normal: candidates are saved, favorite, defaults, then history, deduped." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled nil) + (wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Reykjavik") + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Tokyo"))) + (should (equal '("Home" "Reykjavik" "Honolulu, HI" "Tokyo") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-saved-locations-boundary-candidates-dedup-saved-wins () + "Boundary: a name present in saved and defaults appears once (saved first)." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled nil) + (wttrin-saved-locations '(("Honolulu, HI" . "Honolulu, HI"))) + (wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history nil)) + (should (equal '("Honolulu, HI" "Berkeley, CA") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +;;; Favorite-as-name resolution + +(ert-deftest test-wttrin-saved-locations-normal-favorite-name-resolves-to-query () + "Normal: a favorite that is a saved name resolves to its query for fetching." + (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans"))) + (wttrin-favorite-location "Home")) + (should (equal "1500 Sugar Bowl Dr, New Orleans" + (wttrin--resolve-favorite-location))))) + +(ert-deftest test-wttrin-saved-locations-normal-favorite-display-shows-name () + "Normal: the favorite display name is the saved name, not its query." + (let ((wttrin-saved-locations '(("Home" . "1500 Sugar Bowl Dr, New Orleans"))) + (wttrin-favorite-location "Home")) + (should (equal "Home" (wttrin--favorite-location-display-name))))) + +;;; Alias cache identity + +(ert-deftest test-wttrin-saved-locations-normal-cache-keyed-on-query () + "Normal: cache identity follows the query, not the display name. +Two names with the same query share a key; the name never leaks into the key." + (let ((wttrin-saved-locations '(("A" . "Paris, FR") ("B" . "Paris, FR")))) + (should (equal (wttrin--make-cache-key (wttrin--resolve-location-query "A")) + (wttrin--make-cache-key (wttrin--resolve-location-query "B")))))) + +;;; History suppression of saved names + +(ert-deftest test-wttrin-saved-locations-boundary-saved-name-not-logged () + "Boundary: a saved-directory name is not added to history." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Home") + (should (null wttrin--location-history))) + (testutil-wttrin-teardown))) + +;;; savehist + +(ert-deftest test-wttrin-saved-locations-integration-savehist-registers () + "Integration: wttrin-saved-locations is registered for savehist persistence." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring))) + (wttrin--savehist-register) + (should (memq 'wttrin-saved-locations savehist-additional-variables)))) + +;;; wttrin--coordinates-p + +(ert-deftest test-wttrin-saved-locations-normal-coordinates-p () + "Normal/Boundary: coordinate strings match; place names do not." + (should (wttrin--coordinates-p "41.37,-71.83")) + (should (wttrin--coordinates-p "1.5,2.5")) + (should-not (wttrin--coordinates-p "New York, NY")) + (should-not (wttrin--coordinates-p "Berkeley, CA")) + (should-not (wttrin--coordinates-p ""))) + +;;; wttrin--put-saved-location + +(ert-deftest test-wttrin-saved-locations-normal-put-adds-and-updates () + "Normal: put adds a new entry and updates an existing name without duplicating." + (let ((wttrin-saved-locations nil)) + (wttrin--put-saved-location "Home" "Paris, FR") + (should (equal "Paris, FR" (wttrin--resolve-location-query "Home"))) + (wttrin--put-saved-location "Home" "Tokyo, JP") + (should (equal "Tokyo, JP" (wttrin--resolve-location-query "Home"))) + (should (= 1 (length (wttrin--saved-locations)))))) + +(ert-deftest test-wttrin-saved-locations-error-put-rejects-empty-and-sentinel () + "Error: put refuses an empty name, empty query, or the sentinel name." + (let ((wttrin-saved-locations nil)) + (should-error (wttrin--put-saved-location "" "Paris") :type 'user-error) + (should-error (wttrin--put-saved-location "Home" "") :type 'user-error) + (should-error (wttrin--put-saved-location wttrin--geolocation-sentinel "x") + :type 'user-error))) + +;;; wttrin-rename-location + +(ert-deftest test-wttrin-saved-locations-normal-rename () + "Normal: rename moves the entry and updates the favorite reference." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Home")) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-rename-location "Home" "Casa")) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Casa"))) + (should-not (assoc "Home" (wttrin--saved-locations))) + (should (equal "Casa" wttrin-favorite-location)))) + +(ert-deftest test-wttrin-saved-locations-error-rename-collision-refused () + "Error: renaming onto an existing name is refused and changes nothing." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP")))) + (should-error (wttrin-rename-location "Home" "Work") :type 'user-error) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Home"))))) + +(ert-deftest test-wttrin-saved-locations-normal-rename-favorite-refreshes-mode-line () + "Normal: renaming the favorite refreshes the mode-line so the icon and tooltip +follow the new name immediately instead of at the next scheduled fetch." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Home") + (wttrin--location-history nil) + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-rename-location "Home" "Casa")) + (should (equal "Casa" wttrin-favorite-location)) + (should fetched))) + +(ert-deftest test-wttrin-saved-locations-boundary-rename-non-favorite-no-refresh () + "Boundary: renaming a location that is not the favorite does not refresh." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP"))) + (wttrin-favorite-location "Work") + (wttrin--location-history nil) + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-rename-location "Home" "Casa")) + (should-not fetched))) + +;;; wttrin-remove-location + +(ert-deftest test-wttrin-saved-locations-normal-remove-confirmed () + "Normal: confirming removes the entry." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should (null (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-remove-declined-keeps () + "Boundary: declining the confirmation keeps the entry." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should (assoc "Home" (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-normal-remove-favorite-refreshes-mode-line () + "Normal: removing the favorite refreshes the mode-line so it stops showing the +now-deleted alias's resolved weather and re-fetches against the bare query." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR"))) + (wttrin-favorite-location "Home") + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should fetched))) + +(ert-deftest test-wttrin-saved-locations-boundary-remove-non-favorite-no-refresh () + "Boundary: removing a location that is not the favorite does not refresh." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR") ("Work" . "Tokyo, JP"))) + (wttrin-favorite-location "Work") + (wttrin-mode-line-mode t) + (fetched nil)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should-not fetched))) + +;;; wttrin-make-default — geolocation naming + +(ert-deftest test-wttrin-saved-locations-normal-d-names-and-promotes () + "Normal: d on a coordinate buffer names it, saves it, and promotes the name." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil)) + (with-temp-buffer + (setq-local wttrin--current-location "41.37,-71.83") + (setq-local wttrin--current-display "41.37,-71.83") + (setq-local wttrin--current-address "Westerly, RI") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "Home")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (equal "41.37,-71.83" (wttrin--resolve-location-query "Home"))) + (should (equal "Home" wttrin-favorite-location)))) + +(ert-deftest test-wttrin-saved-locations-boundary-d-empty-keeps-coordinates () + "Boundary: an empty name at the d prompt keeps the coordinates, saves no entry." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil)) + (with-temp-buffer + (setq-local wttrin--current-location "41.37,-71.83") + (setq-local wttrin--current-address "Westerly, RI") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (null (wttrin--saved-locations))) + (should (equal "41.37,-71.83" wttrin-favorite-location)))) + +(ert-deftest test-wttrin-saved-locations-boundary-d-named-buffer-no-prompt () + "Boundary: d on a named buffer promotes the display name without prompting." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil) + (prompted nil)) + (with-temp-buffer + (setq-local wttrin--current-location "1500 Sugar Bowl Dr") + (setq-local wttrin--current-display "Craig's House") + (cl-letf (((symbol-function 'read-string) + (lambda (&rest _) (setq prompted t) "x")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should-not prompted) + (should (equal "Craig's House" wttrin-favorite-location)))) + +;;; interactive entry smoke tests (cover the prompt forms) + +(ert-deftest test-wttrin-saved-locations-normal-save-location-interactive () + "Normal: the interactive save command reads the buffer query and a name." + (let ((wttrin-saved-locations nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Paris, FR") + (setq-local wttrin--current-display "Paris, FR") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "Home")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-save-location))) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Home"))))) + +(ert-deftest test-wttrin-saved-locations-normal-rename-interactive () + "Normal: the interactive rename command prompts for the entry and new name." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Home")) + ((symbol-function 'read-string) (lambda (&rest _) "Casa")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-rename-location)) + (should (equal "Paris, FR" (wttrin--resolve-location-query "Casa"))))) + +(ert-deftest test-wttrin-saved-locations-normal-remove-interactive () + "Normal: the interactive remove command prompts and confirms." + (let ((wttrin-saved-locations '(("Home" . "Paris, FR")))) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "Home")) + ((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-remove-location)) + (should (null (wttrin--saved-locations))))) + +(ert-deftest test-wttrin-saved-locations-boundary-save-empty-name-cancels () + "Boundary: an empty name at the save prompt cancels without saving." + (let ((wttrin-saved-locations nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Paris, FR") + (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " ")) + ((symbol-function 'message) (lambda (&rest _) nil))) + (call-interactively 'wttrin-save-location))) + (should (null (wttrin--saved-locations))))) + +;;; coordinate suppression in history + +(ert-deftest test-wttrin-saved-locations-boundary-coordinates-not-logged () + "Boundary: a raw coordinate string is never added to history." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin-saved-locations nil) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "41.37,-71.83") + (should (null wttrin--location-history))) + (testutil-wttrin-teardown))) + +(provide 'test-wttrin-saved-locations) +;;; test-wttrin-saved-locations.el ends here diff --git a/tests/test-wttrin-set-location-from-geolocation.el b/tests/test-wttrin-set-location-from-geolocation.el index e7c3a97..f16b2ae 100644 --- a/tests/test-wttrin-set-location-from-geolocation.el +++ b/tests/test-wttrin-set-location-from-geolocation.el @@ -65,6 +65,29 @@ (should (string= "Pre-existing, Place" wttrin-favorite-location))) (test-wttrin-set-location-from-geolocation-teardown))) +(ert-deftest test-wttrin-set-location-from-geolocation-normal-confirm-refreshes-mode-line () + "Normal: a confirmed detection refreshes the mode-line so it tracks the new +favorite immediately instead of at the next scheduled fetch." + (test-wttrin-set-location-from-geolocation-setup) + (setq wttrin-favorite-location "Pre-existing, Place") + (unwind-protect + (let ((wttrin-geolocation-enabled t) + (wttrin-mode-line-mode t) + (wttrin--location-history nil) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (callback) (funcall callback "Berkeley, California"))) + ((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin-set-location-from-geolocation)) + (should (string= "Berkeley, California" wttrin-favorite-location)) + (should fetched)) + (test-wttrin-set-location-from-geolocation-teardown))) + ;;; Boundary Cases (ert-deftest test-wttrin-set-location-from-geolocation-boundary-unicode-location () diff --git a/tests/test-wttrin-use-current-location.el b/tests/test-wttrin-use-current-location.el index 2b08448..4b61657 100644 --- a/tests/test-wttrin-use-current-location.el +++ b/tests/test-wttrin-use-current-location.el @@ -52,6 +52,27 @@ (should (equal "Berkeley, CA" wttrin-favorite-location))) (test-wttrin-use-current-location-teardown))) +(ert-deftest test-wttrin-use-current-location-normal-confirm-refreshes-mode-line () + "Normal: confirming refreshes the mode-line so it switches to the current +location immediately rather than at the next scheduled fetch." + (test-wttrin-use-current-location-setup) + (setq wttrin-favorite-location "Berkeley, CA") + (unwind-protect + (let ((wttrin-geolocation-enabled t) + (wttrin-mode-line-mode t) + (wttrin--location-history nil) + (fetched nil)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin-use-current-location)) + (should (eq t wttrin-favorite-location)) + (should fetched)) + (test-wttrin-use-current-location-teardown))) + ;;; Boundary / Error Cases (ert-deftest test-wttrin-use-current-location-boundary-disabled-no-prompt-no-set () @@ -83,6 +83,13 @@ visible on monochrome glyphs." Emacs 28+, and wttrin supports 24.4, so the default inherits `bold'." :group 'wttrin) +(defface wttrin-instructions-header + '((t :inherit (bold shadow))) + "Face for the two column headers in the weather buffer footer. +Styles the \"This view\" and \"Saved locations\" labels that head the +two key-hint columns." + :group 'wttrin) + (defcustom wttrin-font-name "Liberation Mono" "Preferred monospaced font name for weather display." :group 'wttrin @@ -197,6 +204,23 @@ or a mobile hotspot — use a string if you need accuracy." (const :tag "Auto-detect via geolocation" t) (string :tag "Location"))) +(defcustom wttrin-saved-locations nil + "Directory of named locations, an alist of (NAME . QUERY) string conses. +NAME is what shows in the picker, the buffer header, and the mode-line. QUERY +is what wttr.in is fetched with: a city, a street address, or \"lat,lng\" +coordinates. For example: + + ((\"Craig's House\" . \"1500 Sugar Bowl Dr, New Orleans\") + (\"Home\" . \"41.37,-71.83\")) + +A bare string S used anywhere a location is expected is shorthand for +\(S . S) — name and query the same. Persisted across sessions via +`savehist-mode'; add entries interactively with \\[wttrin-save-location] or the +`d' key in a weather buffer, or set this in your init." + :group 'wttrin + :type '(alist :key-type (string :tag "Name") + :value-type (string :tag "Query"))) + (defvar wttrin--resolved-favorite-location nil "Cached geolocation result for `wttrin-favorite-location' = t. Holds the resolved \"City, Region\" string so subsequent reads @@ -208,17 +232,19 @@ Prevents duplicate concurrent lookups when several consumers ask during the resolution window.") (defun wttrin--resolve-favorite-location () - "Return the favorite location as a string, or nil if unavailable. + "Return the favorite location's query string, or nil if unavailable. Resolves `wttrin-favorite-location' across the three modes: - nil -> nil (disabled) -- a string -> the string as-is +- a string -> its saved-locations query when the string is a saved name, + otherwise the string as-is (the query for a plain location) - t -> the cached geolocation result. When the cache is empty and no lookup is in flight, kicks off an async detect and returns nil for this call. The next call after the lookup completes returns the resolved string." (cond ((null wttrin-favorite-location) nil) - ((stringp wttrin-favorite-location) wttrin-favorite-location) + ((stringp wttrin-favorite-location) + (wttrin--resolve-location-query wttrin-favorite-location)) ((eq wttrin-favorite-location t) (or wttrin--resolved-favorite-location (progn @@ -245,11 +271,14 @@ call retries." (defun wttrin--favorite-location-display-name () "Return a human-readable name for the favorite location. -Returns the resolved string when available; otherwise returns -\"current location\" if auto-detect is configured but pending, -or nil if the favorite is disabled." - (or (wttrin--resolve-favorite-location) - (when (eq wttrin-favorite-location t) "current location"))) +For a string favorite this is the string itself (a saved-location name shows as +its name, not its resolved query). For t it is the resolved geolocation place, +or \"current location\" while a lookup is pending. Nil when disabled." + (cond + ((stringp wttrin-favorite-location) wttrin-favorite-location) + ((eq wttrin-favorite-location t) + (or wttrin--resolved-favorite-location "current location")) + (t nil))) (defcustom wttrin-mode-line-refresh-interval 3600 "Interval in seconds to refresh mode-line weather data. @@ -548,13 +577,15 @@ Persisted across sessions via `savehist-mode'.") (defun wttrin--savehist-register () "Ensure wttrin's persisted variables are saved by savehist. -Registers `wttrin--location-history' and `wttrin-favorite-location' so both -survive across restarts without the Emacs custom-variable mechanism. +Registers `wttrin--location-history', `wttrin-favorite-location', and +`wttrin-saved-locations' so they survive across restarts without the Emacs +custom-variable mechanism. Run both at load and on `savehist-save-hook', so the registration survives a user `setq' of `savehist-additional-variables' (a common config pattern) that would otherwise drop the entries before they could be saved." (add-to-list 'savehist-additional-variables 'wttrin--location-history) - (add-to-list 'savehist-additional-variables 'wttrin-favorite-location)) + (add-to-list 'savehist-additional-variables 'wttrin-favorite-location) + (add-to-list 'savehist-additional-variables 'wttrin-saved-locations)) (with-eval-after-load 'savehist (wttrin--savehist-register) @@ -568,13 +599,17 @@ name. It is never persisted to history or the cache as a location.") (defun wttrin--add-to-location-history (location) "Record LOCATION as a recent successful search. -No-op when LOCATION is nil, empty, the geolocation sentinel, or already a -default location. An existing entry is promoted to most-recent, and the list -is trimmed to `wttrin-location-history-max'." +No-op when LOCATION is nil, empty, the geolocation sentinel, raw \"LAT,LNG\" +coordinates, a default location, or a saved-directory name (coordinates jitter +and saved names are already offered via the directory). An existing entry is +promoted to most-recent, and the list is trimmed to +`wttrin-location-history-max'." (when (and location (not (string= location "")) (not (string= location wttrin--geolocation-sentinel)) - (not (member location wttrin-default-locations))) + (not (wttrin--coordinates-p location)) + (not (member location wttrin-default-locations)) + (not (assoc location (wttrin--saved-locations)))) (setq wttrin--location-history (delete location wttrin--location-history)) (push location wttrin--location-history) (let ((max (max 0 wttrin-location-history-max))) @@ -583,20 +618,110 @@ is trimmed to `wttrin-location-history-max'." (butlast wttrin--location-history (- (length wttrin--location-history) max))))))) +(defun wttrin--saved-locations () + "Return `wttrin-saved-locations' as a clean list of (NAME . QUERY) pairs. +Skips malformed entries — non-cons, a non-string name or query, or an empty +name or query — and trims surrounding whitespace, so stale or hand-edited +config never errors. A bare string S is read as (S . S)." + (delq nil + (mapcar + (lambda (entry) + (cond + ((and (consp entry) (stringp (car entry)) (stringp (cdr entry))) + (let ((name (string-trim (car entry))) + (query (string-trim (cdr entry)))) + (and (> (length name) 0) (> (length query) 0) (cons name query)))) + ((stringp entry) + (let ((s (string-trim entry))) + (and (> (length s) 0) (cons s s)))) + (t nil))) + wttrin-saved-locations))) + +(defun wttrin--resolve-location-query (selection) + "Return the query string for a picker SELECTION. +When SELECTION is a saved-location name, return its query; otherwise return +SELECTION unchanged, so typed, default, and history strings pass through." + (or (cdr (assoc selection (wttrin--saved-locations))) + selection)) + +(defun wttrin--coordinates-p (string) + "Return non-nil when STRING looks like \"LAT,LNG\" coordinates. +Used to keep a raw geolocation fix out of history and to decide when the +`d' key should prompt for a name instead of promoting coordinates directly." + (and (stringp string) + (string-match-p "\\`[ ]*-?[0-9.]+[ ]*,[ ]*-?[0-9.]+[ ]*\\'" string))) + +(defun wttrin--saved-locations-without (name) + "Return `wttrin-saved-locations' with any entry named NAME removed." + (delq nil + (mapcar (lambda (entry) + (unless (and (consp entry) (equal (car entry) name)) entry)) + wttrin-saved-locations))) + +(defun wttrin--put-saved-location (name query) + "Add or update NAME -> QUERY in `wttrin-saved-locations'; return the saved name. +Trims NAME and QUERY. Signals a `user-error' for an empty name or query, or a +name equal to the geolocation sentinel. An existing name has its query updated." + (let ((name (string-trim (or name ""))) + (query (string-trim (or query "")))) + (when (string= name "") (user-error "Location name cannot be empty")) + (when (string= query "") (user-error "Location query cannot be empty")) + (when (string= name wttrin--geolocation-sentinel) + (user-error "That name is reserved for the geolocation entry")) + (setq wttrin-saved-locations + (append (wttrin--saved-locations-without name) + (list (cons name query)))) + name)) + +(defun wttrin--remove-saved-location (name) + "Remove the saved location named NAME from `wttrin-saved-locations'." + (setq wttrin-saved-locations (wttrin--saved-locations-without name))) + +(defvar-local wttrin--current-location nil + "Query for the weather shown in this buffer (the fetch/cache identity).") + +(defvar-local wttrin--current-display nil + "Display name for the weather shown in this buffer (a saved-location name). +Falls back to the query when there is no distinct name.") + +(defvar-local wttrin--current-address nil + "Resolved address for this buffer, shown on the \"Location:\" line. +Set by the geolocation command path; nil otherwise.") + +(defun wttrin--location-name-prefill () + "Best prefill for naming the current buffer's place when saving it. +An existing alias name (a display distinct from the query), else the detected +address, else the query. Shared by the save command and the `d' key so both +offer the same starting text." + (or (and wttrin--current-display + (not (equal wttrin--current-display wttrin--current-location)) + wttrin--current-display) + wttrin--current-address + wttrin--current-location)) + +(defun wttrin--current-saved-name () + "Return this buffer's display name when it names a saved location, else nil. +Lets the rename and remove commands default to the place on screen." + (and wttrin--current-display + (assoc wttrin--current-display (wttrin--saved-locations)) + wttrin--current-display)) + (defun wttrin--completion-candidates () - "Return the favorite, default locations, then search-history entries. -History already excludes defaults (see `wttrin--add-to-location-history'), and -`wttrin--set-favorite-location' drops the favorite from history. The favorite -\(`wttrin-favorite-location', when a string) is prepended unless it is already a -default, so it always appears exactly once." - (let* ((candidates (append wttrin-default-locations wttrin--location-history)) - (with-favorite (if (and (stringp wttrin-favorite-location) - (not (member wttrin-favorite-location candidates))) - (cons wttrin-favorite-location candidates) - candidates))) + "Return picker candidates: saved names, the favorite, defaults, then history. +De-duplicated by display string with precedence saved > favorite > defaults > +history (the explicit alias wins over a same-named default or history string), +so each place appears exactly once. The geolocation sentinel is prepended when +geolocation is enabled." + (let* ((saved (mapcar #'car (wttrin--saved-locations))) + (favorite (and (stringp wttrin-favorite-location) + (list wttrin-favorite-location))) + (deduped (delete-dups + (append saved favorite + (copy-sequence wttrin-default-locations) + (copy-sequence wttrin--location-history))))) (if wttrin-geolocation-enabled - (cons wttrin--geolocation-sentinel with-favorite) - with-favorite))) + (cons wttrin--geolocation-sentinel deduped) + deduped))) (defun wttrin--sort-completions (candidates) "Return CANDIDATES with the geolocation sentinel pinned first. @@ -633,17 +758,19 @@ can fall back to typing a city in the picker." (wttrin-geolocation-detect (lambda (location &optional address) (if location - (wttrin-query location address) + (wttrin-query location nil address) (message "Could not detect location (network or provider error)")))))) (defun wttrin--query-selection (selection) "Route a picker SELECTION to the right query path. -The geolocation sentinel routes to `wttrin--detect-then-query'; any other -SELECTION is queried literally via `wttrin-query'. This is the single guard -that keeps the sentinel from reaching `wttrin-query' as a place name." +The geolocation sentinel routes to `wttrin--detect-then-query'. Any other +SELECTION is resolved through the saved-locations directory to its query and +fetched with the name shown as the display value, so an alias shows its name +while wttr.in is hit with the target. This is the single guard that keeps the +sentinel from reaching `wttrin-query' as a place name." (if (string= selection wttrin--geolocation-sentinel) (wttrin--detect-then-query) - (wttrin-query selection))) + (wttrin-query (wttrin--resolve-location-query selection) selection))) (defun wttrin-remove-location-history (location) "Remove LOCATION from the search history. @@ -661,6 +788,75 @@ Prompts with completion over the current history entries." (setq wttrin--location-history nil) (message "Location history cleared"))) +;;; Saved-location directory management + +;;;###autoload +(defun wttrin-save-location (name query) + "Save QUERY under NAME in the saved-locations directory. +Interactively, default QUERY to the current weather buffer's location (or +prompt for one), and prefill the name with the buffer's display name, else its +address, else the query. Saving an existing name updates its query." + (interactive + (let* ((query (or wttrin--current-location + (wttrin--resolve-location-query + (completing-read + "Save which location (query): " + (wttrin--completion-table (wttrin--completion-candidates)))))) + (name (read-string "Save location as: " (wttrin--location-name-prefill)))) + (list name query))) + (if (string= (string-trim name) "") + (message "Cancelled") + (let ((existing (assoc (string-trim name) (wttrin--saved-locations))) + (saved (wttrin--put-saved-location name query))) + (message (if existing "Updated %s" "Saved %s") saved)))) + +(defun wttrin-rename-location (old new) + "Rename the saved location OLD to NEW. +Refuses when NEW already names a different entry. When OLD is the favorite, +the favorite is updated to NEW." + (interactive + (let* ((default (wttrin--current-saved-name)) + (old (completing-read "Rename saved location: " + (mapcar #'car (wttrin--saved-locations)) + nil t nil nil default)) + (new (read-string "New name: " old))) + (list old new))) + (let ((new (string-trim new)) + (entry (assoc old (wttrin--saved-locations)))) + (cond + ((not entry) (user-error "No saved location named %s" old)) + ((string= new "") (user-error "New name cannot be empty")) + ((and (not (string= new old)) (assoc new (wttrin--saved-locations))) + (user-error "A saved location named %s already exists" new)) + (t + (let ((query (cdr entry))) + (wttrin--remove-saved-location old) + (wttrin--put-saved-location new query) + (when (equal wttrin-favorite-location old) + (wttrin--set-favorite-location new)) + (message "Renamed %s to %s" old new)))))) + +(defun wttrin-remove-location (name) + "Remove the saved location NAME from the directory, after confirmation. +When NAME is the favorite, it is left as a literal query with a warning." + (interactive + (list (completing-read "Remove saved location: " + (mapcar #'car (wttrin--saved-locations)) + nil t nil nil (wttrin--current-saved-name)))) + (cond + ((not (assoc name (wttrin--saved-locations))) + (user-error "No saved location named %s" name)) + ((yes-or-no-p (format "Remove saved location \"%s\"? " name)) + (wttrin--remove-saved-location name) + (if (equal wttrin-favorite-location name) + (progn + (when (bound-and-true-p wttrin-mode-line-mode) + (wttrin--mode-line-refresh-now)) + (message "Removed %s; it was your favorite and is now a literal query until you set a new one" + name)) + (message "Removed %s" name))) + (t (message "Cancelled")))) + (defun wttrin--requery-location (new-location) "Kill current weather buffer and query NEW-LOCATION." (when (get-buffer "*wttr.in*") @@ -683,6 +879,9 @@ Prompts with completion over the current history entries." (define-key map (kbd "a") 'wttrin-requery) (define-key map (kbd "g") 'wttrin-requery-force) (define-key map (kbd "d") 'wttrin-make-default) + (define-key map (kbd "s") 'wttrin-save-location) + (define-key map (kbd "r") 'wttrin-rename-location) + (define-key map (kbd "x") 'wttrin-remove-location) ;; Note: 'q' is bound to quit-window by special-mode map) "Keymap for wttrin-mode.") @@ -734,22 +933,52 @@ Returns processed string ready for display." (delete-region (line-beginning-position) (1+ (line-end-position)))) (buffer-string)))) +(defconst wttrin--footer-left-width 23 + "Visible width of the left column in the weather-buffer footer. +The right column begins at this offset so the two columns align.") + +(defun wttrin--footer-cell (key label) + "Return a propertized \"[KEY] LABEL\" footer cell. +The bracketed KEY uses `wttrin-key'; LABEL uses `wttrin-instructions'." + (concat (propertize (format "[%s]" key) 'face 'wttrin-key) + (propertize (format " %s" label) 'face 'wttrin-instructions))) + +(defun wttrin--footer-pad (cell width) + "Pad CELL with trailing spaces to a visible WIDTH. +Returns CELL unchanged when it is already at least WIDTH characters wide." + (let ((deficit (- width (length cell)))) + (if (> deficit 0) + (concat cell (make-string deficit ?\s)) + cell))) + (defun wttrin--add-buffer-instructions () - "Add the key-hint footer at the bottom of the current buffer. -Bracketed key chords use `wttrin-key'; the surrounding prose uses -`wttrin-instructions'." + "Add the two-column key-hint footer at the bottom of the current buffer. +The left column lists keys that act on the current view; the right column +lists keys that act on the saved-locations directory. Bracketed key chords +use `wttrin-key', labels use `wttrin-instructions', and the column headers +use `wttrin-instructions-header'." (goto-char (point-max)) (insert "\n\n") - (dolist (segment '(("Press: " . wttrin-instructions) - ("[a]" . wttrin-key) - (" for another location " . wttrin-instructions) - ("[g]" . wttrin-key) - (" to refresh " . wttrin-instructions) - ("[d]" . wttrin-key) - (" to make default " . wttrin-instructions) - ("[q]" . wttrin-key) - (" to quit" . wttrin-instructions))) - (insert (propertize (car segment) 'face (cdr segment))))) + (let* ((header (concat (wttrin--footer-pad + (propertize "This view" 'face 'wttrin-instructions-header) + wttrin--footer-left-width) + (propertize "Saved locations" + 'face 'wttrin-instructions-header))) + (rows (list (cons (wttrin--footer-cell "a" "another") + (wttrin--footer-cell "s" "save")) + (cons (wttrin--footer-cell "g" "refresh") + (wttrin--footer-cell "d" "make default")) + (cons (wttrin--footer-cell "q" "quit") + (wttrin--footer-cell "r" "rename")) + (cons nil + (wttrin--footer-cell "x" "remove")))) + (lines (cons header + (mapcar (lambda (row) + (concat (wttrin--footer-pad (or (car row) "") + wttrin--footer-left-width) + (or (cdr row) ""))) + rows)))) + (insert (mapconcat #'identity lines "\n")))) (defun wttrin--format-staleness-header (location) "Return a staleness header string for LOCATION, or nil if no cache entry. @@ -773,67 +1002,80 @@ even though the weather was fetched by raw coordinates." (when (and (stringp address) (> (length address) 0)) (propertize (concat "Location: " address) 'face 'wttrin-staleness-header))) -(defun wttrin--display-weather (location-name raw-string &optional error-msg address) - "Display weather data RAW-STRING for LOCATION-NAME in weather buffer. -When ERROR-MSG is provided and data is invalid, show that instead of -the generic error message. When ADDRESS is non-empty, show it on a -\"Location:\" line below the weather (used by the geolocation command path, -which fetches by coordinates but can name the place)." - (when wttrin-debug - (wttrin--save-debug-data location-name raw-string)) - - (if (not (wttrin--validate-weather-data raw-string)) - (message "wttrin: %s" - (or error-msg - "Cannot retrieve weather data. Perhaps the location was misspelled?")) - (wttrin--add-to-location-history location-name) - (let ((buffer (get-buffer-create (format "*wttr.in*")))) - (switch-to-buffer buffer) - - ;; wttrin-mode calls kill-all-local-variables, so it must run - ;; before setting any buffer-local state (xterm-color, location) - (wttrin-mode) - - (let ((inhibit-read-only t)) - (erase-buffer) - ;; xterm-color--state must be set AFTER wttrin-mode for the same - ;; reason — mode initialization would wipe it - (require 'xterm-color) - (setq-local xterm-color--state :char) - (insert (wttrin--process-weather-content raw-string)) - ;; wttr.in returns location in lowercase — replace with user's casing - (goto-char (point-min)) - (when (re-search-forward "^Weather report: .*$" nil t) - (replace-match (concat "Weather report: " location-name))) - (let ((location-line (wttrin--format-location-line address))) - (when location-line - (insert "\n" location-line))) - (let ((staleness (wttrin--format-staleness-header location-name))) - (when staleness - (insert "\n" staleness))) - (wttrin--add-buffer-instructions) - (goto-char (point-min))) - - (setq-local wttrin--current-location location-name) - (wttrin--debug-mode-line-info)))) - -(defun wttrin-query (location-name &optional address) - "Asynchronously query weather of LOCATION-NAME, display result when ready. -LOCATION-NAME is what weather is fetched by (and the cache key). Optional -ADDRESS is a human-readable place name shown on a \"Location:\" line, used when -LOCATION-NAME is raw coordinates from a geolocation command." +(defun wttrin--display-weather (query raw-string &optional error-msg display address) + "Display weather RAW-STRING for QUERY in the weather buffer. +QUERY is the location wttr.in was fetched with — the cache key and the buffer's +refresh identity. DISPLAY is what the header shows (a saved-location name); +when nil it falls back to QUERY. ERROR-MSG, when provided and the data is +invalid, is shown instead of the generic error. ADDRESS, when non-empty, shows +on a \"Location:\" line below the weather (the geolocation path fetches by +coordinates but can name the place)." + (let ((display (or display query))) + (when wttrin-debug + (wttrin--save-debug-data query raw-string)) + + (if (not (wttrin--validate-weather-data raw-string)) + (message "wttrin: %s" + (or error-msg + "Cannot retrieve weather data. Perhaps the location was misspelled?")) + (wttrin--add-to-location-history display) + (let ((buffer (get-buffer-create (format "*wttr.in*")))) + (switch-to-buffer buffer) + + ;; wttrin-mode calls kill-all-local-variables, so it must run + ;; before setting any buffer-local state (xterm-color, location) + (wttrin-mode) + + (let ((inhibit-read-only t)) + (erase-buffer) + ;; xterm-color--state must be set AFTER wttrin-mode for the same + ;; reason — mode initialization would wipe it + (require 'xterm-color) + (setq-local xterm-color--state :char) + (insert (wttrin--process-weather-content raw-string)) + ;; wttr.in returns location in lowercase — replace with the display name + (goto-char (point-min)) + (when (re-search-forward "^Weather report: .*$" nil t) + (replace-match (concat "Weather report: " display))) + (let ((location-line (wttrin--format-location-line address))) + (when location-line + (insert "\n" location-line))) + ;; The cache is keyed on QUERY, so the staleness header reads QUERY. + (let ((staleness (wttrin--format-staleness-header query))) + (when staleness + (insert "\n" staleness))) + (wttrin--add-buffer-instructions) + (goto-char (point-min))) + + ;; Anchor the window to the top. Point is at point-min, but when the + ;; buffer is taller than the window a reused window can keep an old + ;; mid-buffer window-start, hiding the weather above the fold. + (let ((win (get-buffer-window buffer))) + (when win (set-window-start win (point-min)))) + + (setq-local wttrin--current-location query) + (setq-local wttrin--current-display display) + (setq-local wttrin--current-address address) + (wttrin--debug-mode-line-info))))) + +(defun wttrin-query (query &optional display address) + "Asynchronously query weather for QUERY, display the result when ready. +QUERY is what weather is fetched by (and the cache key). Optional DISPLAY is +the name shown in the header (a saved-location name); when nil it falls back to +QUERY. Optional ADDRESS is shown on a \"Location:\" line, used when QUERY is raw +coordinates from a geolocation command." (let ((buffer (get-buffer-create (format "*wttr.in*")))) (switch-to-buffer buffer) (setq buffer-read-only nil) (erase-buffer) - (insert "Loading weather for " location-name "...") + (insert "Loading weather for " (or display query) "...") (setq buffer-read-only t) (wttrin--get-cached-or-fetch - location-name + query (lambda (raw-string &optional error-msg) (when (buffer-live-p buffer) (with-current-buffer buffer - (wttrin--display-weather location-name raw-string error-msg address))))))) + (wttrin--display-weather query raw-string error-msg display address))))))) (defun wttrin--make-cache-key (location) "Create cache key from LOCATION and current settings." @@ -923,7 +1165,7 @@ the detected city as your default." (message "Could not detect location (network or provider error)")) ((yes-or-no-p (format "Detected location: %s. Set as favorite? " location)) - (setq wttrin-favorite-location location) + (wttrin--set-favorite-location location) (message "Set wttrin-favorite-location to: %s%s" location (if (bound-and-true-p savehist-mode) @@ -952,7 +1194,7 @@ Does nothing when `wttrin-geolocation-enabled' is nil." ((not wttrin-geolocation-enabled) (message "Geolocation is disabled (set wttrin-geolocation-enabled to enable it)")) ((yes-or-no-p "Always use your current location (auto-detect via geolocation)? ") - (setq wttrin-favorite-location t) + (wttrin--set-favorite-location t) (message "Favorite location set to auto-detect%s" (if (bound-and-true-p savehist-mode) " (persisted via savehist)." @@ -960,16 +1202,15 @@ Does nothing when `wttrin-geolocation-enabled' is nil." (t (message "Cancelled")))) -(defvar-local wttrin--current-location nil - "Current location displayed in this weather buffer.") - (defun wttrin-requery-force () "Force refresh weather data for current location, bypassing cache." (interactive) (if wttrin--current-location (let ((wttrin--force-refresh t)) (message "Refreshing weather data...") - (wttrin-query wttrin--current-location)) + (wttrin-query wttrin--current-location + wttrin--current-display + wttrin--current-address)) (message "No location to refresh"))) (defun wttrin--set-favorite-location (location) @@ -988,15 +1229,30 @@ here works whether or not savehist is loaded." (defun wttrin-make-default () "Make the location shown in this buffer the favorite (persisted) default. -Sets `wttrin-favorite-location' to the displayed location so it drives the -mode-line and survives restarts. No-op with a message when the buffer has -no current location." +A named buffer (a saved alias or a typed location) is promoted directly. A raw +coordinate buffer (a fresh geolocation detection) first prompts for a name, +prefilled with the detected address; the entered name is saved to the directory +and promoted. An empty name keeps the raw coordinates as the default. No-op +with a message when the buffer has no current location." (interactive) - (if wttrin--current-location - (progn - (wttrin--set-favorite-location wttrin--current-location) - (message "wttrin: %s is now the default location" wttrin--current-location)) - (message "wttrin: no location to make default"))) + (cond + ((null wttrin--current-location) + (message "wttrin: no location to make default")) + ((wttrin--coordinates-p wttrin--current-location) + (let ((name (string-trim + (read-string "Save location as (empty keeps coordinates): " + (wttrin--location-name-prefill))))) + (if (string= name "") + (progn + (wttrin--set-favorite-location wttrin--current-location) + (message "wttrin: %s is now the default location" wttrin--current-location)) + (wttrin--put-saved-location name wttrin--current-location) + (wttrin--set-favorite-location name) + (message "wttrin: %s is now the default location" name)))) + (t + (let ((favorite (or wttrin--current-display wttrin--current-location))) + (wttrin--set-favorite-location favorite) + (message "wttrin: %s is now the default location" favorite))))) ;;; Mode-line weather display @@ -1079,10 +1335,11 @@ proceeds normally." (let ((trimmed-data (string-trim data))) (wttrin--debug-log "mode-line-fetch: Received data = %S" trimmed-data) (if (wttrin--mode-line-valid-response-p trimmed-data) - (progn + (let ((display (or (wttrin--favorite-location-display-name) + location))) (setq wttrin--mode-line-cache (cons (float-time) - (wttrin--replace-response-location trimmed-data location))) + (wttrin--replace-response-location trimmed-data display))) (wttrin--mode-line-update-display)) (wttrin--debug-log "mode-line-fetch: Invalid response, keeping previous display"))) ;; Network error / nil data |
