diff options
36 files changed, 3507 insertions, 290 deletions
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d8fa309..b963389 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -115,9 +115,6 @@ jobs: - name: Run coverage run: make coverage - - name: Print coverage summary - run: python3 scripts/coverage-summary.py - - name: Upload coverage report uses: actions/upload-artifact@v4 with: @@ -7,3 +7,12 @@ /dist/ *.elc *-autoloads.el +*~ +__pycache__/ +*.pyc + +# --- elisp ruleset --- +.claude/ +CLAUDE.md +githooks/ +*.eln @@ -46,6 +46,10 @@ TEST_UTIL_FILES = $(wildcard $(TEST_DIR)/testutil-*.el) # Coverage configuration COVERAGE_DIR = .coverage COVERAGE_FILE = $(COVERAGE_DIR)/simplecov.json +# Whole-project summary: prints per-file coverage plus source files absent from +# the report (modules no test loaded) counted as 0%. Self-contained, stock Emacs. +COVERAGE_SUMMARY = scripts/coverage-summary.el +COVERAGE_SOURCE_DIR = . # Plain emacs invocation (no package archives, used for parens-check) EMACS_BATCH = $(EMACS) --batch --no-site-file --no-site-lisp @@ -55,7 +59,7 @@ EASK_EMACS = $(EMACS_ENV) $(EASK) emacs --batch -q -L $(PROJECT_ROOT) -L $(TEST_ .PHONY: help test test-all test-smoke test-unit test-integration test-file test-name \ deps install-deps validate-parens validate compile lint \ - coverage coverage-clean \ + coverage coverage-summary coverage-clean \ clean clean-compiled clean-tests # Default target @@ -74,6 +78,7 @@ help: @echo "" @echo " Coverage:" @echo " make coverage - Generate simplecov JSON at $(COVERAGE_FILE)" + @echo " make coverage-summary - Print per-file + whole-project summary (untested modules at 0%)" @echo " make coverage-clean - Delete the coverage report file" @echo "" @echo " Validation:" @@ -231,6 +236,17 @@ coverage: coverage-clean $(COVERAGE_DIR) echo "[!] No coverage file produced; check that undercover is installed"; \ exit 1; \ fi + @$(MAKE) coverage-summary + +# Whole-project summary. Stock Emacs only (no Eask deps) — the script needs just +# the built-in `json' and `seq'. Counts a source file with no report entry as 0%. +coverage-summary: + @if [ ! -f $(COVERAGE_FILE) ]; then \ + echo "[!] No coverage report at $(COVERAGE_FILE). Run 'make coverage' first."; \ + exit 1; \ + fi + @$(EMACS) --batch -q -l $(COVERAGE_SUMMARY) \ + --eval '(cj/coverage-print-module-summary "$(COVERAGE_FILE)" "$(COVERAGE_SOURCE_DIR)" "$(CURDIR)")' coverage-clean: @rm -f $(COVERAGE_FILE) @@ -106,7 +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, 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. (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)"). @@ -129,6 +131,24 @@ Most people will just want to add a bunch of cities to the location list. Howeve "41.89,12.48")) ;; GPS Coordinates for Rome #+end_src +*** Location Search 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. + +#+begin_src emacs-lisp + (setq wttrin-location-history-max 20) +#+end_src + +To persist the history across Emacs restarts, enable the built-in =savehist-mode=. Wttrin keeps its history variable registered automatically, even if you set =savehist-additional-variables= yourself, so there is nothing else to configure. Without =savehist-mode=, history lasts for the session only. + +#+begin_src emacs-lisp + (savehist-mode 1) +#+end_src + +Two commands manage the history: =M-x wttrin-remove-location-history= drops a single entry (with completion), and =M-x wttrin-clear-location-history= clears all of it. + *** Default Language Customizing 'wttrin-default-languages' allows users to tell Wttrin which language to request for the text it displays. For instance, this changes the language used for days of the week, periods of the day, and other related text. @@ -246,24 +266,20 @@ If a refresh fails, the emoji dims to gray and the tooltip tells you what went w *Note:* If the weather emoji appears as a monochrome symbol instead of a color icon, try setting `wttrin-mode-line-emoji-font` to match a color emoji font installed on your system. Use `M-x fc-list` or check your system fonts to see what's available. -*** Setting the Favorite Location from IP Geolocation -If you don't want to type your city by hand, wttrin can detect it for you. Two ways: +*** Weather for Your Current Location +If you don't want to type your city by hand, wttrin can detect it for you. -**Manual detection with confirmation:** +**From the picker (weather here, right now):** run =M-x wttrin= and pick the first entry, "Current location (detect)". wttrin looks up your city via IP geolocation and shows its weather. If the guess is wrong (VPN, mobile hotspot), the detected city is right there in the buffer header, so just open the picker again and type the correct city. -#+begin_src emacs-lisp - M-x wttrin-set-location-from-geolocation -#+end_src - -This looks up your city via IP geolocation, shows the detected location, and sets =wttrin-favorite-location= after you confirm. To make the setting persist across Emacs sessions, run =M-x customize-save-variable RET wttrin-favorite-location RET=, or add =(setq wttrin-favorite-location "Your City, State")= to your init file. +**Make the detected city your default:** in that weather buffer, press =d=. The detected city becomes =wttrin-favorite-location= (what the mode-line tracks). With =savehist-mode= on, the favorite persists across sessions automatically, since wttrin registers it with savehist. No =customize-save-variable= step is needed. -**Automatic detection on first use:** +**Always use my current location:** run =M-x wttrin-use-current-location=, or set the variable directly: #+begin_src emacs-lisp (setq wttrin-favorite-location t) #+end_src -When set to =t=, wttrin runs the geolocation lookup once on first use (when the mode-line first fetches, when the buffer cache first refreshes, etc.) and caches the result for the rest of the session. The lookup happens in the background, so Emacs startup isn't blocked. The first display tick shows a placeholder until the lookup returns; everything proceeds normally after that. +When set to =t=, wttrin runs the geolocation lookup once on first use (when the mode-line first fetches, when the buffer cache first refreshes, etc.) and caches the result for the rest of the session. The lookup happens in the background, so Emacs startup isn't blocked. The first display tick shows a placeholder until the lookup returns; everything proceeds normally after that. =M-x wttrin-use-current-location= is the labeled, confirmed way to choose this without typing the bare =t=. The default lookup provider is =ipapi.co=. Two alternatives ship with the package, both free and key-less: @@ -273,7 +289,82 @@ The default lookup provider is =ipapi.co=. Two alternatives ship with the packag (setq wttrin-geolocation-provider 'ipwhois) ;; ipwho.is (10k/month) #+end_src -*Note:* IP-based geolocation can be wrong when you are behind a VPN or using a mobile hotspot. The confirmation prompt lets you reject an inaccurate result. If you prefer, set =wttrin-favorite-location= directly to any city string that wttr.in understands. +*Note:* IP-based geolocation can be wrong when you are behind a VPN or using a mobile hotspot. If you prefer, set =wttrin-favorite-location= directly to any city string that wttr.in understands. + +**Higher accuracy via an external command:** IP geolocation only finds your network's exit point, which on a VPN or cellular hotspot can be the wrong city or state. For a more accurate fix, point =wttrin-geolocation-command= at a command that returns your coordinates as JSON: + +#+begin_src emacs-lisp + (setq wttrin-geolocation-command "your-location-script --json") +#+end_src + +The command runs asynchronously and must print a JSON object with numeric =lat= and =lng= keys. It may also include an =address= (or =label=) string; when present, wttrin shows it on a "Location:" line in the weather buffer so the resolved place is readable even though the weather is fetched by raw coordinates. Any other keys are ignored. For example: + +#+begin_src json + {"lat": 41.3222, "lng": -71.8113, "address": "Westerly, Rhode Island, USA"} +#+end_src + +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. + +**Turning geolocation off:** geolocation is on by default. To opt out — no "Current location" entry in the picker, no detection requests — set: + +#+begin_src emacs-lisp + (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 — "Superdome" 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 + '(("Superdome" . "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 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: + +#+begin_src emacs-lisp + (set-face-attribute 'wttrin-key nil :foreground "deep sky blue" :weight 'bold) + (set-face-attribute 'wttrin-staleness-header nil :slant 'italic) +#+end_src ** Debugging and Troubleshooting If something isn't working, debug mode logs every fetch, every display update, and every error. 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/examples/geolocation/README.org b/examples/geolocation/README.org new file mode 100644 index 0000000..2a5462e --- /dev/null +++ b/examples/geolocation/README.org @@ -0,0 +1,164 @@ +#+TITLE: wttrin geolocation command adapters + +These are example programs for ~wttrin-geolocation-command~. wttrin can run an +external command to find your location with far better accuracy than IP +geolocation (which only finds your network's exit point — wrong on a VPN or a +cellular hotspot). The command scans nearby WiFi access points, looks them up, +and prints coordinates; wttrin then queries wttr.in by those coordinates. + +These are *examples*, not part of the installed package. Copy one, adapt it to +your system, and point the variable at it: + +#+begin_src emacs-lisp + (setq wttrin-geolocation-command "/path/to/google-geolocate.py") +#+end_src + +* The contract + +A command prints one JSON object to standard output and exits zero: + +#+begin_src json + {"lat": 41.3222, "lng": -71.8113, "accuracy_m": 25.0, "address": "Westerly, Rhode Island, USA"} +#+end_src + +- ~lat~ and ~lng~ (numbers) are required. wttrin fetches weather for them. +- ~address~ (or ~label~) is optional. When present, wttrin shows it on a + "Location:" line in the weather buffer, so the resolved place is readable even + though the weather was fetched by raw coordinates. +- Any other keys are ignored. + +On any failure the command should exit non-zero (and may print a message to +standard error). wttrin then falls back to the IP provider named by +~wttrin-geolocation-provider~, so geolocation still works. + +* The adapters + +** google-geolocate.py +Uses the Google Geolocation API. Documented, supported, accurate, broad +coverage. Needs an API key (see below). Recommended starting point. + +** apple-wps.py +Uses Apple's WiFi positioning service. Keyless and accurate, but it queries an +*undocumented* Apple endpoint via a reverse-engineered protocol, which may be +contrary to Apple's terms of service. Read the caveat at the top of the file and +decide for yourself. Provided as an example only. + +* Requirements + +- Python 3 (standard library only — no packages to install). +- A WiFi scanner. Both examples use ~nmcli~ (NetworkManager), which is common on + Linux. On a system without NetworkManager, replace the ~scan_wifi~ function + with your platform's scanner; that is the only platform-specific part. See + "Adapting the WiFi scan" below for systemd-networkd, iwd, and macOS. +- Network access. Both also do a best-effort reverse-geocode via OpenStreetMap + Nominatim to fill in ~address~; if that call fails the coordinates are still + returned, just without an address. + +* Adapting the WiFi scan + +~scan_wifi~ needs, for each nearby access point, its BSSID (MAC address) and a +signal strength. nmcli gives a 0-100 quality (the examples convert it to dBm); +the sources below give dBm directly. Swap in whichever your system has and adjust +the parsing to match the sample line. + +** systemd-networkd (via wpa_supplicant) +networkd handles addressing, not WiFi scanning — the scan comes from +wpa_supplicant. No root needed when wpa_supplicant is already running. + +#+begin_src sh + wpa_cli -i wlan0 scan + wpa_cli -i wlan0 scan_results +#+end_src + +Output columns are =BSSID frequency signal(dBm) flags SSID= (tab-separated): + +#+begin_example + 00:11:22:33:44:55 2437 -65 [WPA2-PSK-CCMP][ESS] MyNetwork +#+end_example + +Take field 1 (BSSID) and field 3 (signal in dBm). + +** iwd +iwd has no scriptable way to list per-AP BSSIDs (=iwctl station <iface> +get-networks= shows SSIDs and aggregated signal, not BSSIDs). On an iwd system, +use =iw= below — it works regardless of the network manager. + +** Any Linux (iw, the low-level tool) +=iw= talks to the kernel directly (nl80211), so it works under NetworkManager, +iwd, wpa_supplicant, or networkd. Triggering a scan needs root. + +#+begin_src sh + sudo iw dev wlan0 scan | grep -E "^BSS|signal:" +#+end_src + +#+begin_example + BSS 00:11:22:33:44:55(on wlan0) + signal: -65.00 dBm +#+end_example + +Pair each =BSS <bssid>= line with the =signal: <dBm>= line that follows it. + +** macOS +macOS restricts WiFi scanning. The old =airport -s= was removed in macOS 14, and +=system_profiler SPAirPortDataType= redacts BSSIDs unless the calling process has +Location Services permission. The reliable path today is a small CoreWLAN helper +(Swift/PyObjC) that, with Location Services granted, reads =CWInterface +scanForNetworksWithName= and returns each network's =bssid= and =rssiValue= +(dBm). Treat macOS as needing that helper rather than a one-liner. + +* Setting up a Google API key + +1. Create a project in the Google Cloud console (https://console.cloud.google.com/). +2. Enable the "Geolocation API" for that project. +3. Create an API key (APIs & Services -> Credentials -> Create credentials -> API key). + Restrict it to the Geolocation API. +4. Note Google's pricing: the Geolocation API is a paid API with a monthly free + allowance. Review current terms before relying on it. +5. Make the key available to the command. The script checks the environment + first, then ~~/.authinfo.gpg~; use whichever you prefer. + +** Option A: an environment variable + +#+begin_src sh + export GOOGLE_GEOLOCATION_API_KEY="your-key-here" +#+end_src + +Put it somewhere your Emacs inherits it (a login shell profile). The script reads +~GOOGLE_GEOLOCATION_API_KEY~ and never stores the key. + +** Option B: ~/.authinfo.gpg (encrypted, recommended) + +Keep the key in the same encrypted store Emacs's auth-source uses. The script +reads it whenever the environment variable is unset. + +1. Open ~~/.authinfo.gpg~ in Emacs. It decrypts transparently for editing. (If + the file doesn't exist, create it; Emacs encrypts it on save once your GnuPG + key is set up.) +2. Add one netrc-style line: + +#+begin_src authinfo + machine googleapis.com login geolocation password YOUR-KEY-HERE +#+end_src + +3. Save the buffer. Emacs re-encrypts the file. +4. Confirm gpg can read it without prompting (gpg-agent caches the passphrase): + +#+begin_src sh + gpg --quiet --decrypt ~/.authinfo.gpg | grep googleapis.com +#+end_src + +The ~login~ field (~geolocation~) is just a label. The script matches on +~machine googleapis.com~ and uses the ~password~ value; the key is never printed +or written in plaintext. + +* Testing an adapter by hand + +Run it in a terminal and check the JSON: + +#+begin_src sh + ./google-geolocate.py + # {"lat": 41.3222, "lng": -71.8113, "accuracy_m": 25.0, "address": "..."} +#+end_src + +If it prints coordinates near you, point ~wttrin-geolocation-command~ at it and +pick "Current location (detect)" in ~M-x wttrin~. diff --git a/examples/geolocation/apple-wps.py b/examples/geolocation/apple-wps.py new file mode 100755 index 0000000..c09b660 --- /dev/null +++ b/examples/geolocation/apple-wps.py @@ -0,0 +1,334 @@ +#!/usr/bin/env python3 +"""apple-wps -- find your location from nearby WiFi via Apple's positioning service. + + CAVEAT, READ FIRST + ------------------ + This queries gs-loc.apple.com, an UNDOCUMENTED Apple endpoint, using a + reverse-engineered protobuf protocol. It is not a public or supported API, + and using it may be contrary to Apple's terms of service. It is provided as + an example only -- decide for yourself whether to use it. It needs no API + key and no account. + +An example adapter for wttrin's `wttrin-geolocation-command'. It scans nearby +WiFi access points, asks Apple for their coordinates, averages the located ones +weighted by signal strength to estimate your position, and prints JSON on stdout: + + {"lat": 41.3222, "lng": -71.8113, "address": "Westerly, Rhode Island, USA"} + +wttrin reads `lat' and `lng' to fetch weather, and shows `address' on the +buffer's "Location:" line. + +Note the difference from Google's API: Google solves your position from a scan +and returns one point. Apple returns the location of *each access point*, so +this script does the averaging itself. + +Requirements: + - Python 3 (standard library only; the protobuf is hand-encoded below). + - nmcli (NetworkManager) for the WiFi scan. Replace `scan_wifi' for a system + without NetworkManager; it is the only platform-specific part. + +Wire it into Emacs: + + (setq wttrin-geolocation-command "/path/to/apple-wps.py") + +On any failure this exits non-zero, so wttrin falls back to its IP provider. +""" + +import json +import re +import struct +import subprocess +import sys +import urllib.error +import urllib.request +from typing import NoReturn + +WLOC_URL = "https://gs-loc.apple.com/clls/wloc" +NOMINATIM_URL = "https://nominatim.openstreetmap.org/reverse?lat={lat}&lon={lng}&format=jsonv2" +# Apple's service inspects the User-Agent; a locationd-like string is expected. +APPLE_USER_AGENT = "locationd/1753.17 CFNetwork/889.9 Darwin/17.2.0" +NOMINATIM_USER_AGENT = "wttrin-apple-wps-example/1.0" + +MAX_ACCESS_POINTS = 12 # cap the request size; the strongest APs suffice +APPLE_UNKNOWN = -18000000000 # value Apple returns for an access point it can't place + + +def fail(message) -> NoReturn: + """Print MESSAGE to stderr and exit non-zero (wttrin falls back to IP).""" + print(f"apple-wps: {message}", file=sys.stderr) + sys.exit(1) + + +# -------------------------------------------------------------------------- +# Minimal protobuf -- only the few wire-format pieces this request and response +# need, so there is no dependency on a protobuf library. +# -------------------------------------------------------------------------- + +def encode_varint(value): + """Encode a non-negative integer as a protobuf base-128 varint.""" + out = bytearray() + while True: + seven_bits = value & 0x7F + value >>= 7 + out.append(seven_bits | (0x80 if value else 0)) + if not value: + return bytes(out) + + +def read_varint(buf, offset): + """Decode a varint from BUF starting at OFFSET; return (value, next_offset).""" + result = shift = 0 + while True: + byte = buf[offset] + offset += 1 + result |= (byte & 0x7F) << shift + if not byte & 0x80: + return result, offset + shift += 7 + + +def tag(field_number, wire_type): + """Encode a protobuf field tag (field number + wire type).""" + return encode_varint((field_number << 3) | wire_type) + + +def length_delimited(field_number, data): + """Encode a length-delimited field (wire type 2): tag, length, then DATA.""" + return tag(field_number, 2) + encode_varint(len(data)) + data + + +def as_signed_64(value): + """Interpret an unsigned 64-bit varint as a two's-complement signed integer.""" + return value - (1 << 64) if value >= (1 << 63) else value + + +# -------------------------------------------------------------------------- +# Request and response +# -------------------------------------------------------------------------- + +def build_request(bssids): + """Build the binary Apple WLOC request for a list of BSSID strings. + + The protobuf is an AppleWLoc message: field 2 is a repeated WifiDevice, and + each WifiDevice has field 1 = the BSSID string. Fields 3 and 4 are small + integers the real client sends (an unknown flag and a single-result flag, + both left 0 here so Apple returns every access point it can). The protobuf + is wrapped in a fixed frame: a start marker, three length-prefixed strings + (locale, the locationd identifier, a client version), and a 2-byte + big-endian payload length. + """ + wifi_devices = b"".join( + length_delimited(2, length_delimited(1, bssid.encode())) + for bssid in bssids) + payload = (wifi_devices + + tag(3, 0) + encode_varint(0) + + tag(4, 0) + encode_varint(0)) + frame = (b"\x00\x01\x00\x05en_US" + b"\x00\x13com.apple.locationd" + b"\x00\x0a8.1.12B411" + b"\x00\x00\x00\x01\x00\x00") + return frame + struct.pack(">H", len(payload)) + payload + + +def query_apple(request_bytes): + """POST REQUEST_BYTES to Apple's WLOC endpoint and return the raw response.""" + request = urllib.request.Request( + WLOC_URL, data=request_bytes, + headers={"User-Agent": APPLE_USER_AGENT, + "Content-Type": "application/x-www-form-urlencoded"}) + try: + with urllib.request.urlopen(request, timeout=20) as response: + return response.read() + except urllib.error.HTTPError as error: + fail(f"Apple WLOC error {error.code}") + except urllib.error.URLError as error: + fail(f"network error: {error.reason}") + + +def parse_response(raw): + """Parse Apple's WLOC response into {normalized_bssid: (lat, lng)}. + + The body begins with a 10-byte prefix before the AppleWLoc protobuf. We walk + its fields, decoding each WifiDevice (field 2) into a BSSID and a location. + """ + buf = raw[10:] + located = {} + offset, end = 0, len(buf) + while offset < end: + key, offset = read_varint(buf, offset) + field_number, wire_type = key >> 3, key & 0x7 + if wire_type == 2: + length, offset = read_varint(buf, offset) + chunk = buf[offset:offset + length] + offset += length + if field_number == 2: + bssid, coords = parse_wifi_device(chunk) + if bssid and coords: + located[normalize_bssid(bssid)] = coords + elif wire_type == 0: + _, offset = read_varint(buf, offset) # skip a varint we don't use + else: + break # unexpected wire type; stop + return located + + +def parse_wifi_device(buf): + """Decode a WifiDevice message: field 1 is the BSSID, field 2 the location.""" + bssid = None + coords = None + offset, end = 0, len(buf) + while offset < end: + key, offset = read_varint(buf, offset) + field_number, wire_type = key >> 3, key & 0x7 + if wire_type == 2: + length, offset = read_varint(buf, offset) + chunk = buf[offset:offset + length] + offset += length + if field_number == 1: + bssid = chunk.decode(errors="replace") + elif field_number == 2: + coords = parse_location(chunk) + elif wire_type == 0: + _, offset = read_varint(buf, offset) + else: + break + return bssid, coords + + +def parse_location(buf): + """Decode a Location message: field 1 latitude, field 2 longitude. + + Both are int64 scaled by 1e8. Apple returns APPLE_UNKNOWN for an access + point it cannot place; those are dropped. Returns (lat, lng) or None. + """ + latitude = longitude = None + offset, end = 0, len(buf) + while offset < end: + key, offset = read_varint(buf, offset) + field_number, wire_type = key >> 3, key & 0x7 + if wire_type == 0: + value, offset = read_varint(buf, offset) + value = as_signed_64(value) + if field_number == 1: + latitude = value + elif field_number == 2: + longitude = value + elif wire_type == 2: + length, offset = read_varint(buf, offset) + offset += length + else: + break + if latitude is None or longitude is None: + return None + if latitude == APPLE_UNKNOWN or longitude == APPLE_UNKNOWN: + return None + return latitude * 1e-8, longitude * 1e-8 + + +# -------------------------------------------------------------------------- +# WiFi scan and position estimate +# -------------------------------------------------------------------------- + +def normalize_bssid(bssid): + """Canonicalize a BSSID to lowercase, zero-padded octets, for reliable matching.""" + return ":".join(octet.rjust(2, "0").lower() for octet in bssid.split(":")) + + +def scan_wifi(): + """Return a list of (normalized_bssid, signal_quality) for visible access points. + + Uses nmcli; SIGNAL is a 0-100 quality percentage used here only to weight the + position average (stronger means nearer). Replace this function to support a + system without NetworkManager. + """ + try: + completed = subprocess.run( + ["nmcli", "-t", "-f", "SIGNAL,BSSID", + "device", "wifi", "list", "--rescan", "yes"], + capture_output=True, text=True, timeout=20, check=True) + except FileNotFoundError: + fail("nmcli not found; replace scan_wifi for your system") + except subprocess.SubprocessError as error: + fail(f"wifi scan failed: {error}") + + access_points = [] + for line in completed.stdout.splitlines(): + # nmcli -t separates fields with colons and backslash-escapes the colons + # inside the BSSID; split on the first unescaped colon, then unescape. + parts = [p.replace("\\:", ":") + for p in re.split(r"(?<!\\):", line, maxsplit=1)] + if len(parts) != 2: + continue + signal, bssid = parts + bssid = normalize_bssid(bssid) + if not re.fullmatch(r"(?:[0-9a-f]{2}:){5}[0-9a-f]{2}", bssid): + continue + try: + quality = int(signal) + except ValueError: + continue + access_points.append((bssid, quality)) + return access_points + + +def signal_weighted_centroid(access_points, located): + """Average the coordinates of access points we see and Apple located. + + Each is weighted by its signal quality, so nearer access points pull the + estimate toward them. Returns (lat, lng) or None when none matched. + """ + total_weight = latitude_sum = longitude_sum = 0.0 + for bssid, weight in access_points: + coords = located.get(bssid) + if coords: + latitude_sum += coords[0] * weight + longitude_sum += coords[1] * weight + total_weight += weight + if total_weight == 0: + return None + return latitude_sum / total_weight, longitude_sum / total_weight + + +def reverse_geocode(lat, lng): + """Return a human-readable address for LAT, LNG, or None on any failure. + + Best-effort via OpenStreetMap Nominatim, which requires a descriptive + User-Agent and rate-limits heavy use. + """ + request = urllib.request.Request( + NOMINATIM_URL.format(lat=lat, lng=lng), + headers={"User-Agent": NOMINATIM_USER_AGENT}) + try: + with urllib.request.urlopen(request, timeout=20) as response: + return json.load(response).get("display_name") + except (urllib.error.URLError, ValueError): + return None + + +def main(): + access_points = scan_wifi() + if len(access_points) < 2: + fail(f"only {len(access_points)} access point(s) visible; need at least 2") + + # Query the strongest access points; Apple also returns nearby ones it knows. + access_points.sort(key=lambda ap: ap[1], reverse=True) + query_bssids = [bssid for bssid, _ in access_points[:MAX_ACCESS_POINTS]] + + located = parse_response(query_apple(build_request(query_bssids))) + position = signal_weighted_centroid(access_points, located) + if position is None: + # If this happens with many APs visible, Apple may want the BSSIDs in a + # different form (some clients strip leading zeros from each octet rather + # than padding them); adjust normalize_bssid and retry. + fail("Apple located none of the visible access points") + + lat, lng = position + result = {"lat": round(lat, 7), "lng": round(lng, 7)} + address = reverse_geocode(lat, lng) + if address: + result["address"] = address + print(json.dumps(result)) + + +if __name__ == "__main__": + main() diff --git a/examples/geolocation/google-geolocate.py b/examples/geolocation/google-geolocate.py new file mode 100755 index 0000000..3acbbe8 --- /dev/null +++ b/examples/geolocation/google-geolocate.py @@ -0,0 +1,190 @@ +#!/usr/bin/env python3 +"""google-geolocate -- find your location from nearby WiFi via the Google Geolocation API. + +An example adapter for wttrin's `wttrin-geolocation-command'. It scans nearby +WiFi access points, sends them to Google's Geolocation API, and prints the +resulting coordinates (plus a reverse-geocoded address) as JSON on stdout: + + {"lat": 41.3222, "lng": -71.8113, "accuracy_m": 25.0, "address": "Westerly, Rhode Island, USA"} + +wttrin reads `lat' and `lng' to fetch weather, and shows `address' on the +buffer's "Location:" line. + +Why this beats IP geolocation: a real WiFi scan fed to Google's database +resolves to street level, where IP geolocation only finds your network's exit +point -- often the wrong city on a VPN or a cellular hotspot. + +Requirements: + - Python 3 (standard library only). + - nmcli (NetworkManager) for the WiFi scan. On a system without + NetworkManager, replace `scan_wifi' with your platform's scanner. + - A Google API key with the Geolocation API enabled, in the environment + variable GOOGLE_GEOLOCATION_API_KEY. See the README for setup and pricing. + +Wire it into Emacs: + + (setq wttrin-geolocation-command "/path/to/google-geolocate.py") + +On any failure this exits non-zero, so wttrin falls back to its IP provider. +""" + +import json +import os +import re +import subprocess +import sys +import urllib.error +import urllib.request +from typing import NoReturn + +GEOLOCATE_URL = "https://www.googleapis.com/geolocation/v1/geolocate?key={key}" +NOMINATIM_URL = "https://nominatim.openstreetmap.org/reverse?lat={lat}&lon={lng}&format=jsonv2" +USER_AGENT = "wttrin-google-geolocate-example/1.0" + + +AUTHINFO_MACHINE = "googleapis.com" # the "machine" entry this looks for in authinfo + + +def fail(message) -> NoReturn: + """Print MESSAGE to stderr and exit non-zero (wttrin falls back to IP).""" + print(f"google-geolocate: {message}", file=sys.stderr) + sys.exit(1) + + +def read_api_key(): + """Return the Google API key, or None if it cannot be found. + + Checks the environment variable GOOGLE_GEOLOCATION_API_KEY first, then + ~/.authinfo.gpg (the encrypted store Emacs's auth-source uses). See the + README for the authinfo line format. + """ + key = os.environ.get("GOOGLE_GEOLOCATION_API_KEY") + if key: + return key + return read_key_from_authinfo() + + +def read_key_from_authinfo(): + """Return the password for the AUTHINFO_MACHINE entry in ~/.authinfo.gpg, or None. + + Decrypts the file with gpg (gpg-agent supplies the passphrase) and reads a + netrc-style line: machine <host> login <user> password <secret>. + """ + path = os.path.expanduser("~/.authinfo.gpg") + if not os.path.exists(path): + return None + try: + decrypted = subprocess.run( + ["gpg", "--quiet", "--batch", "--decrypt", path], + capture_output=True, text=True, timeout=30, check=True).stdout + except (FileNotFoundError, subprocess.SubprocessError): + return None + for line in decrypted.splitlines(): + tokens = line.split() + if "machine" in tokens and "password" in tokens: + pairs = dict(zip(tokens[::2], tokens[1::2])) + if pairs.get("machine") == AUTHINFO_MACHINE: + return pairs.get("password") + return None + + +def scan_wifi(): + """Return a list of {"macAddress", "signalStrength"} for visible access points. + + Uses nmcli. Its SIGNAL column is a 0-100 quality percentage; NetworkManager + maps quality = 2 * (dBm + 100), so dBm = quality / 2 - 100, which is the unit + Google's API expects. Replace this function to support a non-NetworkManager + system (for example macOS via CoreWLAN); it is the only platform-specific part. + """ + try: + completed = subprocess.run( + ["nmcli", "-t", "-f", "SIGNAL,BSSID", + "device", "wifi", "list", "--rescan", "yes"], + capture_output=True, text=True, timeout=20, check=True) + except FileNotFoundError: + fail("nmcli not found; replace scan_wifi for your system") + except subprocess.SubprocessError as error: + fail(f"wifi scan failed: {error}") + + access_points = [] + for line in completed.stdout.splitlines(): + # In nmcli -t output, fields are colon-separated and literal colons + # inside a field (the BSSID) are backslash-escaped. Splitting on the + # first unescaped colon separates SIGNAL from the BSSID, then we unescape. + parts = [p.replace("\\:", ":") + for p in re.split(r"(?<!\\):", line, maxsplit=1)] + if len(parts) != 2: + continue + signal, bssid = parts + if not re.fullmatch(r"(?:[0-9A-Fa-f]{2}:){5}[0-9A-Fa-f]{2}", bssid): + continue + try: + quality = int(signal) + except ValueError: + continue + access_points.append({"macAddress": bssid, + "signalStrength": quality // 2 - 100}) + return access_points + + +def google_geolocate(access_points, key): + """Ask Google for a position from ACCESS_POINTS; return (lat, lng, accuracy).""" + body = json.dumps({"considerIp": False, + "wifiAccessPoints": access_points}).encode() + request = urllib.request.Request( + GEOLOCATE_URL.format(key=key), data=body, + headers={"Content-Type": "application/json", "User-Agent": USER_AGENT}) + try: + with urllib.request.urlopen(request, timeout=20) as response: + data = json.load(response) + except urllib.error.HTTPError as error: + detail = error.read().decode(errors="replace")[:200] + fail(f"Google API error {error.code}: {detail}") + except urllib.error.URLError as error: + fail(f"network error: {error.reason}") + + location = data.get("location", {}) + return location.get("lat"), location.get("lng"), data.get("accuracy") + + +def reverse_geocode(lat, lng): + """Return a human-readable address for LAT, LNG, or None on any failure. + + Best-effort via OpenStreetMap Nominatim, which requires a descriptive + User-Agent and rate-limits heavy use. + """ + request = urllib.request.Request( + NOMINATIM_URL.format(lat=lat, lng=lng), + headers={"User-Agent": USER_AGENT}) + try: + with urllib.request.urlopen(request, timeout=20) as response: + return json.load(response).get("display_name") + except (urllib.error.URLError, ValueError): + return None + + +def main(): + key = read_api_key() + if not key: + fail("no API key: set GOOGLE_GEOLOCATION_API_KEY or add it to " + "~/.authinfo.gpg (see README)") + + access_points = scan_wifi() + if len(access_points) < 2: + fail(f"only {len(access_points)} access point(s) visible; need at least 2") + + lat, lng, accuracy = google_geolocate(access_points, key) + if lat is None or lng is None: + fail("Google returned no location") + + result = {"lat": lat, "lng": lng} + if accuracy is not None: + result["accuracy_m"] = accuracy + address = reverse_geocode(lat, lng) + if address: + result["address"] = address + print(json.dumps(result)) + + +if __name__ == "__main__": + main() diff --git a/scripts/coverage-summary.el b/scripts/coverage-summary.el new file mode 100644 index 0000000..895102e --- /dev/null +++ b/scripts/coverage-summary.el @@ -0,0 +1,177 @@ +;;; coverage-summary.el --- Whole-project coverage summary from a SimpleCov report -*- lexical-binding: t; -*- + +;;; Commentary: +;; Batch helper for `make coverage-summary'. After `make coverage' writes an +;; undercover SimpleCov JSON report, this prints a per-file table, a project +;; number, and the source files present on disk but absent from the report. +;; +;; The value here is the missing-file detection: a module no test imports never +;; appears in the SimpleCov output, so it silently fails to drag the number +;; down. This script counts such a file as 0% and weights the project number +;; by file rather than by line, so untested modules are visible. +;; +;; Self-contained on purpose — lives in the project's tracked =scripts/= (so CI +;; can reach it) and must run with nothing but stock Emacs (`json' is built in). +;; The SimpleCov +;; JSON shape it parses is: +;; { <suite>: { "coverage": { <abs-path>: [null | 0 | int, ...] } } } +;; where a null entry is a non-executable line, 0 is executable-but-unhit, and +;; any positive integer is a hit. Data unions across multiple suite keys. +;; +;; CLI contract (mirrors the dotemacs original): +;; emacs --batch -l coverage-summary.el \ +;; --eval '(cj/coverage-print-module-summary REPORT SRC-DIR PROJECT-ROOT)' + +;;; Code: + +(require 'json) +(require 'seq) + +(defun cj/coverage-summary--parse-file (report-file) + "Parse REPORT-FILE (SimpleCov JSON) into per-file (COVERED . TOTAL) counts. + +Keys are absolute source-file paths. TOTAL counts executable lines (numeric +entries); COVERED counts hit lines (entries greater than zero). Data unions +across every top-level suite key. Signals `user-error' when REPORT-FILE is +missing or malformed." + (unless (file-exists-p report-file) + (user-error "Coverage report not found: %s" report-file)) + (let* ((json-object-type 'hash-table) + (json-array-type 'list) + (json-key-type 'string) + (data (condition-case err + (json-read-file report-file) + (error (user-error "Malformed coverage JSON in %s: %s" + report-file (error-message-string err))))) + ;; path -> (covered-set . total-set), line numbers held in hash sets so + ;; unioning across suites never double-counts a shared line. + (acc (make-hash-table :test 'equal))) + (maphash + (lambda (_suite section) + (when (hash-table-p section) + (let ((coverage (gethash "coverage" section))) + (when (hash-table-p coverage) + (maphash + (lambda (path hits-list) + (let* ((cell (or (gethash path acc) + (puthash path + (cons (make-hash-table :test 'eql) + (make-hash-table :test 'eql)) + acc))) + (covered (car cell)) + (total (cdr cell)) + (line 1)) + (dolist (hits hits-list) + (when (numberp hits) + (puthash line t total) + (when (> hits 0) (puthash line t covered))) + (setq line (1+ line))))) + coverage))))) + data) + (let ((result (make-hash-table :test 'equal))) + (maphash (lambda (path cell) + (puthash path + (cons (hash-table-count (car cell)) + (hash-table-count (cdr cell))) + result)) + acc) + result))) + +(defun cj/coverage-summary--under-dir (table source-dir project-root) + "Filter TABLE to files under SOURCE-DIR, re-keyed relative to PROJECT-ROOT." + (let ((result (make-hash-table :test 'equal)) + (source-dir (file-name-as-directory (expand-file-name source-dir))) + (project-root (file-name-as-directory (expand-file-name project-root)))) + (maphash + (lambda (path counts) + (let ((abs (expand-file-name path))) + (when (string-prefix-p source-dir abs) + (puthash (file-relative-name abs project-root) counts result)))) + table) + result)) + +(defun cj/coverage-summary--source-files (source-dir project-root) + "Return *.el files directly under SOURCE-DIR, relative to PROJECT-ROOT. +Sorted. Compiled files and subdirectories are out of scope, as are generated +package files (`*-autoloads.el', `*-pkg.el') -- a build tool writes those, no +test covers them, and counting them as untested source skews the number." + (let ((source-dir (file-name-as-directory (expand-file-name source-dir))) + (project-root (file-name-as-directory (expand-file-name project-root)))) + (sort (seq-remove + (lambda (p) (string-match-p "\\(?:-autoloads\\|-pkg\\)\\.el\\'" p)) + (mapcar (lambda (p) (file-relative-name p project-root)) + (directory-files source-dir t "\\.el\\'"))) + #'string<))) + +(defun cj/coverage-summary--missing (tracked source-dir project-root) + "Return source files present on disk but absent from TRACKED. +TRACKED is a list of project-relative paths (the report's keys under +SOURCE-DIR). The difference is the set of files no test exercised." + (seq-difference + (cj/coverage-summary--source-files source-dir project-root) + tracked + #'string=)) + +(defun cj/coverage-summary--file-pct (covered total) + "Return COVERED/TOTAL as a percentage. +A file with no executable lines (TOTAL 0) is 100% — nothing left uncovered." + (if (> total 0) (/ (* 100.0 covered) total) 100.0)) + +(defun cj/coverage-summary--project-pct (report-file source-dir project-root) + "Return the unit-weighted project coverage percentage. +Every tracked file contributes its own percentage; every source file missing +from REPORT-FILE contributes 0%. The result is the mean over all files under +SOURCE-DIR, so an untested module drags the number down instead of vanishing." + (let* ((tracked (cj/coverage-summary--under-dir + (cj/coverage-summary--parse-file report-file) + source-dir project-root)) + (keys (let (ks) (maphash (lambda (k _v) (push k ks)) tracked) ks)) + (missing (cj/coverage-summary--missing keys source-dir project-root)) + (score 0.0) + (total-count (+ (hash-table-count tracked) (length missing)))) + (maphash (lambda (_k counts) + (setq score (+ score (cj/coverage-summary--file-pct + (car counts) (cdr counts))))) + tracked) + (if (> total-count 0) (/ score total-count) 0.0))) + +(defun cj/coverage-summary-text (report-file source-dir project-root) + "Return a whole-project coverage summary for SOURCE-DIR from REPORT-FILE." + (let* ((tracked (cj/coverage-summary--under-dir + (cj/coverage-summary--parse-file report-file) + source-dir project-root)) + (rel-src (file-relative-name + (expand-file-name source-dir) + (file-name-as-directory (expand-file-name project-root)))) + (keys (let (ks) (maphash (lambda (k _v) (push k ks)) tracked) ks)) + (missing (cj/coverage-summary--missing keys source-dir project-root)) + (pct (cj/coverage-summary--project-pct report-file source-dir project-root))) + (with-temp-buffer + (insert (format "Coverage summary for %s\n\n" rel-src)) + (dolist (path (sort keys #'string<)) + (let* ((counts (gethash path tracked)) + (covered (car counts)) + (total (cdr counts))) + (insert (format " %6.1f%% %s (%d/%d lines)\n" + (cj/coverage-summary--file-pct covered total) + path covered total)))) + (insert (format "\nProject coverage: %.1f%% (%d tracked, %d missing, %d total; missing files count as 0%%)\n" + pct (hash-table-count tracked) (length missing) + (+ (hash-table-count tracked) (length missing)))) + (insert (format "\nNot in coverage report: %d file%s\n" + (length missing) (if (= 1 (length missing)) "" "s"))) + (if missing + (progn + (insert "These files had no coverage entry; they count as 0% in project coverage.\n") + (dolist (path (sort missing #'string<)) + (insert (format " %s\n" path)))) + (insert "Every source file appears in the coverage report.\n")) + (buffer-string)))) + +(defun cj/coverage-print-module-summary (report-file source-dir project-root) + "Print a whole-project coverage summary for SOURCE-DIR from REPORT-FILE." + (princ "\n") + (princ (cj/coverage-summary-text report-file source-dir project-root))) + +(provide 'coverage-summary) +;;; coverage-summary.el ends here diff --git a/scripts/coverage-summary.py b/scripts/coverage-summary.py deleted file mode 100755 index 9b7bc99..0000000 --- a/scripts/coverage-summary.py +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/env python3 -"""Print a per-file and overall coverage summary from undercover's simplecov JSON. - -Usage: - python3 scripts/coverage-summary.py [path] - -If `path` is omitted, defaults to `.coverage/simplecov.json`. -Exit code is 0 on success, 1 if the JSON is missing or malformed. -""" - -import json -import os -import sys - - -def main(path: str) -> int: - try: - with open(path) as f: - data = json.load(f) - except FileNotFoundError: - print(f"error: {path} not found; run `make coverage` first", file=sys.stderr) - return 1 - except json.JSONDecodeError as exc: - print(f"error: {path} is not valid JSON: {exc}", file=sys.stderr) - return 1 - - try: - suite = data["undercover.el"]["coverage"] - except (KeyError, TypeError): - print(f"error: {path} does not look like an undercover simplecov report", - file=sys.stderr) - return 1 - - print(f'{"File":<30} {"Lines":>7} {"Covered":>8} {"Coverage":>10}') - print("-" * 60) - - total_lines = 0 - total_covered = 0 - for fname, lines in suite.items(): - relevant = [l for l in lines if l is not None] - covered = sum(1 for l in relevant if l > 0) - pct = 100.0 * covered / len(relevant) if relevant else 0.0 - total_lines += len(relevant) - total_covered += covered - short = os.path.basename(fname) - print(f"{short:<30} {len(relevant):>7} {covered:>8} {pct:>9.2f}%") - - print("-" * 60) - overall = 100.0 * total_covered / total_lines if total_lines else 0.0 - print(f'{"TOTAL":<30} {total_lines:>7} {total_covered:>8} {overall:>9.2f}%') - return 0 - - -if __name__ == "__main__": - target = sys.argv[1] if len(sys.argv) > 1 else ".coverage/simplecov.json" - sys.exit(main(target)) diff --git a/tests/test-wttrin--add-buffer-instructions.el b/tests/test-wttrin--add-buffer-instructions.el index 4949c45..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 [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 [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,10 +81,28 @@ (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)))))) +(ert-deftest test-wttrin--add-buffer-instructions-normal-key-chords-carry-key-face () + "Bracketed key chords are styled with `wttrin-key'." + (with-temp-buffer + (wttrin--add-buffer-instructions) + (goto-char (point-min)) + (search-forward "[a]") + ;; point is just after the closing bracket; the bracket char is part + ;; of the "[a]" segment + (should (eq (get-text-property (1- (point)) 'face) 'wttrin-key)))) + +(ert-deftest test-wttrin--add-buffer-instructions-normal-prose-carries-instructions-face () + "The footer prose is styled with `wttrin-instructions'." + (with-temp-buffer + (wttrin--add-buffer-instructions) + (goto-char (point-min)) + (search-forward "another") + (should (eq (get-text-property (1- (point)) 'face) 'wttrin-instructions)))) + ;;; Boundary Cases (ert-deftest test-wttrin--add-buffer-instructions-boundary-point-at-beginning-appends-at-end () @@ -81,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 [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 () @@ -91,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 [q] to quit" + (should (string-suffix-p "[x] remove" (buffer-string))))) (ert-deftest test-wttrin--add-buffer-instructions-boundary-trailing-newlines-preserves-newlines () @@ -99,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 [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 () @@ -108,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 \\[q\\] to quit" nil)))) + (should (looking-back "\\[x\\] remove" nil)))) ;;; Error Cases @@ -134,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 bca6a6c..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 @@ -159,11 +160,8 @@ Empty string does not match ERROR pattern, so it's processed as data." (test-wttrin--display-weather-setup) (unwind-protect (progn - (let ((message-log-max t) - (message-displayed nil)) - (cl-letf (((symbol-function 'message) - (lambda (format-string &rest args) - (setq message-displayed (apply #'format format-string args))))) + (let ((message-log-max t)) + (testutil-wttrin-with-captured-message message-displayed (wttrin--display-weather "InvalidCity" nil) ;; Should display error message @@ -176,11 +174,8 @@ Empty string does not match ERROR pattern, so it's processed as data." (test-wttrin--display-weather-setup) (unwind-protect (progn - (let ((message-log-max t) - (message-displayed nil)) - (cl-letf (((symbol-function 'message) - (lambda (format-string &rest args) - (setq message-displayed (apply #'format format-string args))))) + (let ((message-log-max t)) + (testutil-wttrin-with-captured-message message-displayed (wttrin--display-weather "BadLocation" testutil-wttrin-sample-error-response) ;; Should display error message diff --git a/tests/test-wttrin--format-location-line.el b/tests/test-wttrin--format-location-line.el new file mode 100644 index 0000000..28a9af8 --- /dev/null +++ b/tests/test-wttrin--format-location-line.el @@ -0,0 +1,35 @@ +;;; test-wttrin--format-location-line.el --- Tests for the buffer Location line -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for `wttrin--format-location-line', the "Location: ADDRESS" line +;; shown in the weather buffer when a geolocation command supplies an address. + +;;; Code: + +(require 'ert) +(require 'wttrin) + +(ert-deftest test-wttrin--format-location-line-normal-builds-line () + "Normal: a non-empty address becomes a \"Location: ...\" line." + (let ((line (wttrin--format-location-line "Westerly, Rhode Island, USA"))) + (should (stringp line)) + (should (string-prefix-p "Location: Westerly, Rhode Island, USA" line)))) + +(ert-deftest test-wttrin--format-location-line-normal-uses-face () + "Normal: the line carries the staleness-header face." + (let ((line (wttrin--format-location-line "Westerly, RI"))) + (should (eq 'wttrin-staleness-header + (get-text-property 0 'face line))))) + +(ert-deftest test-wttrin--format-location-line-boundary-nil-returns-nil () + "Boundary: a nil address yields no line." + (should (null (wttrin--format-location-line nil)))) + +(ert-deftest test-wttrin--format-location-line-boundary-empty-returns-nil () + "Boundary: an empty address yields no line." + (should (null (wttrin--format-location-line "")))) + +(provide 'test-wttrin--format-location-line) +;;; test-wttrin--format-location-line.el ends here diff --git a/tests/test-wttrin--format-staleness-header.el b/tests/test-wttrin--format-staleness-header.el index 5658be0..7a39b9a 100644 --- a/tests/test-wttrin--format-staleness-header.el +++ b/tests/test-wttrin--format-staleness-header.el @@ -50,6 +50,18 @@ (should (string-match-p "just now" header))))) (test-wttrin--format-staleness-header-teardown))) +(ert-deftest test-wttrin--format-staleness-header-normal-carries-face () + "The returned header string is styled with `wttrin-staleness-header'." + (test-wttrin--format-staleness-header-setup) + (unwind-protect + (let ((now 1000000.0)) + (cl-letf (((symbol-function 'float-time) (lambda () now))) + (testutil-wttrin-add-to-cache "Paris" "weather data" 300) + (let ((header (wttrin--format-staleness-header "Paris"))) + (should (eq (get-text-property 0 'face header) + 'wttrin-staleness-header))))) + (test-wttrin--format-staleness-header-teardown))) + ;;; Boundary Cases (ert-deftest test-wttrin--format-staleness-header-boundary-no-cache-returns-nil () diff --git a/tests/test-wttrin--handle-fetch-callback.el b/tests/test-wttrin--handle-fetch-callback.el index d4158ac..e50c61d 100644 --- a/tests/test-wttrin--handle-fetch-callback.el +++ b/tests/test-wttrin--handle-fetch-callback.el @@ -226,12 +226,9 @@ (ert-deftest test-wttrin--handle-fetch-callback-error-network-shows-message () "Network errors should show a specific message in the echo area, not leave the user guessing." - (let ((displayed-message nil)) + (testutil-wttrin-with-captured-message displayed-message (cl-letf (((symbol-function 'wttrin--extract-response-body) - (lambda () nil)) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) + (lambda () nil))) (wttrin--handle-fetch-callback '(:error (error "Network unreachable")) #'ignore) @@ -240,14 +237,11 @@ not leave the user guessing." (ert-deftest test-wttrin--handle-fetch-callback-error-http-404-shows-message () "HTTP 404 should tell the user the location wasn't found." - (let ((displayed-message nil)) + (testutil-wttrin-with-captured-message displayed-message (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) ((symbol-function 'wttrin--extract-http-status) - (lambda () 404)) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) + (lambda () 404))) ;; No :error in status — url-retrieve succeeded but server returned 404 (wttrin--handle-fetch-callback nil #'ignore) (should displayed-message) @@ -255,14 +249,11 @@ not leave the user guessing." (ert-deftest test-wttrin--handle-fetch-callback-error-http-500-shows-message () "HTTP 500 should tell the user the weather service had an error." - (let ((displayed-message nil)) + (testutil-wttrin-with-captured-message displayed-message (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) ((symbol-function 'wttrin--extract-http-status) - (lambda () 500)) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) + (lambda () 500))) (wttrin--handle-fetch-callback nil #'ignore) (should displayed-message) (should (string-match-p "service\\|server\\|500" (downcase displayed-message)))))) diff --git a/tests/test-wttrin--mode-line-helpers.el b/tests/test-wttrin--mode-line-helpers.el index 408711b..21ac167 100644 --- a/tests/test-wttrin--mode-line-helpers.el +++ b/tests/test-wttrin--mode-line-helpers.el @@ -46,40 +46,40 @@ (should (equal (plist-get face :family) "Noto Color Emoji")) (should (equal (plist-get face :height) 1.0)))))) -(ert-deftest test-wttrin--make-emoji-icon-normal-with-foreground () - "Foreground color should be applied when specified." +(ert-deftest test-wttrin--make-emoji-icon-normal-with-face () + "A face should be applied via :inherit when specified." (let ((wttrin-mode-line-emoji-font nil)) - (let ((result (wttrin--make-emoji-icon "☀" "gray60"))) + (let ((result (wttrin--make-emoji-icon "☀" 'wttrin-mode-line-stale))) (let ((face (get-text-property 0 'face result))) - (should (equal (plist-get face :foreground) "gray60")))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale)))))) -(ert-deftest test-wttrin--make-emoji-icon-normal-with-font-and-foreground () - "Both font and foreground should be applied together." +(ert-deftest test-wttrin--make-emoji-icon-normal-with-font-and-face () + "Both font and face should be applied together." (let ((wttrin-mode-line-emoji-font "Noto Color Emoji")) - (let ((result (wttrin--make-emoji-icon "⏳" "gray60"))) + (let ((result (wttrin--make-emoji-icon "⏳" 'wttrin-mode-line-stale))) (let ((face (get-text-property 0 'face result))) (should (equal (plist-get face :family) "Noto Color Emoji")) - (should (equal (plist-get face :foreground) "gray60")))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale)))))) ;;; Boundary Cases -(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-foreground-no-color () - "Nil foreground should not add any :foreground property when no font." +(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-face-no-font () + "Nil face with no font should return a plain string." (let ((wttrin-mode-line-emoji-font nil)) (let ((result (wttrin--make-emoji-icon "☀" nil))) - ;; Without font or foreground, should be plain string + ;; Without font or face, should be plain string (should (equal result "☀"))))) -(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-foreground-with-font () - "With font set and nil foreground, the face plist must omit :foreground entirely. -A literal `:foreground nil' entry triggers \"Invalid face attribute\" warnings on +(ert-deftest test-wttrin--make-emoji-icon-boundary-nil-face-with-font () + "With font set and nil face, the face plist must omit :inherit entirely. +A literal `:inherit nil' entry triggers \"Invalid face attribute\" warnings on every redisplay. `plist-member' (not `plist-get') is required: `plist-get' can't distinguish a missing key from a present key bound to nil." (let ((wttrin-mode-line-emoji-font "Noto Color Emoji")) (let* ((result (wttrin--make-emoji-icon "☀" nil)) (face (get-text-property 0 'face result))) (should (equal (plist-get face :family) "Noto Color Emoji")) - (should-not (plist-member face :foreground))))) + (should-not (plist-member face :inherit))))) ;;; -------------------------------------------------------------------------- ;;; wttrin--set-mode-line-string diff --git a/tests/test-wttrin--mode-line-update-display.el b/tests/test-wttrin--mode-line-update-display.el index 0635b5f..be066e7 100644 --- a/tests/test-wttrin--mode-line-update-display.el +++ b/tests/test-wttrin--mode-line-update-display.el @@ -170,7 +170,7 @@ (test-wttrin--mode-line-update-display-teardown))) (ert-deftest test-wttrin--mode-line-update-display-stale-emoji-dimmed () - "Stale data dims the emoji with gray foreground." + "Stale data dims the emoji via the `wttrin-mode-line-stale' face." (test-wttrin--mode-line-update-display-setup) (unwind-protect (let ((wttrin-mode-line-refresh-interval 900) @@ -178,13 +178,13 @@ (cl-letf (((symbol-function 'float-time) (lambda () 3000.0))) (setq wttrin--mode-line-cache (cons 1000.0 "Paris: X +61°F Clear")) (wttrin--mode-line-update-display) - ;; The emoji character should have a gray face + ;; The emoji character should inherit the stale face (let* ((str wttrin-mode-line-string) ;; Find the emoji position (after the space) (emoji-pos 1) (face (get-text-property emoji-pos 'face str))) (should face) - (should (equal (plist-get face :foreground) "gray60"))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale))))) (test-wttrin--mode-line-update-display-teardown))) ;;; Boundary Cases @@ -223,7 +223,7 @@ trigger an emoji re-render so dimming matches the tooltip's staleness state." (wttrin--mode-line-update-display) ;; Emoji should NOT be dimmed (let ((face (get-text-property 1 'face wttrin-mode-line-string))) - (should-not (and face (equal (plist-get face :foreground) "gray60"))))) + (should-not (and face (eq (plist-get face :inherit) 'wttrin-mode-line-stale))))) ;; Time passes: data is now stale (age=2001, threshold=1800) ;; Invoke the tooltip (simulating a hover) — this should trigger a re-render @@ -233,7 +233,7 @@ trigger an emoji re-render so dimming matches the tooltip's staleness state." ;; After hover detected staleness transition, emoji should now be dimmed (let ((face (get-text-property 1 'face wttrin-mode-line-string))) (should face) - (should (equal (plist-get face :foreground) "gray60"))))) + (should (eq (plist-get face :inherit) 'wttrin-mode-line-stale))))) (test-wttrin--mode-line-update-display-teardown))) ;;; -------------------------------------------------------------------------- @@ -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-clear-cache.el b/tests/test-wttrin-clear-cache.el index 8185c5f..784be4c 100644 --- a/tests/test-wttrin-clear-cache.el +++ b/tests/test-wttrin-clear-cache.el @@ -43,13 +43,10 @@ "User should be told the cache was cleared." (test-wttrin-clear-cache-setup) (unwind-protect - (let ((displayed-message nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) - (wttrin-clear-cache) - (should displayed-message) - (should (string-match-p "cache cleared" displayed-message)))) + (testutil-wttrin-with-captured-message displayed-message + (wttrin-clear-cache) + (should displayed-message) + (should (string-match-p "cache cleared" displayed-message))) (test-wttrin-clear-cache-teardown))) ;;; Boundary Cases diff --git a/tests/test-wttrin-error-types.el b/tests/test-wttrin-error-types.el new file mode 100644 index 0000000..dd3df2d --- /dev/null +++ b/tests/test-wttrin-error-types.el @@ -0,0 +1,128 @@ +;;; test-wttrin-error-types.el --- Tests for wttrin's typed error hierarchy -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the define-error hierarchy (wttrin-error and children), +;; the wttrin--error-message constructor, the wttrin-error-type accessor, +;; and the error-class tagging of the async fetch callback's error-msg. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; Setup and Teardown + +(defun test-wttrin-error-types-setup () + "Setup for error-type tests." + (testutil-wttrin-setup)) + +(defun test-wttrin-error-types-teardown () + "Teardown for error-type tests." + (testutil-wttrin-teardown)) + +;;; Hierarchy + +(ert-deftest test-wttrin-error-types-normal-parent-inherits-error () + "wttrin-error is a child of the built-in error condition." + (should (memq 'error (get 'wttrin-error 'error-conditions))) + (should (memq 'wttrin-error (get 'wttrin-error 'error-conditions)))) + +(ert-deftest test-wttrin-error-types-normal-children-inherit-parent-and-error () + "Each child condition inherits both wttrin-error and error." + (dolist (child '(wttrin-invalid-input + wttrin-network-error + wttrin-not-found-error + wttrin-service-error + wttrin-parse-error)) + (let ((conds (get child 'error-conditions))) + (should (memq child conds)) + (should (memq 'wttrin-error conds)) + (should (memq 'error conds))))) + +;;; wttrin--error-message constructor + +(ert-deftest test-wttrin-error-types-normal-error-message-carries-type-property () + "wttrin--error-message returns the formatted string tagged with its type." + (let ((msg (wttrin--error-message 'wttrin-network-error "Network error"))) + (should (string= "Network error" msg)) + (should (eq 'wttrin-network-error (get-text-property 0 'wttrin-error-type msg))))) + +(ert-deftest test-wttrin-error-types-normal-error-message-formats-arguments () + "wttrin--error-message applies format arguments like `format'." + (let ((msg (wttrin--error-message 'wttrin-not-found-error + "Location not found (HTTP %d)" 404))) + (should (string= "Location not found (HTTP 404)" msg)) + (should (eq 'wttrin-not-found-error (wttrin-error-message-type msg))))) + +;;; wttrin-error-type accessor + +(ert-deftest test-wttrin-error-types-normal-error-type-reads-tag () + "wttrin-error-type returns the class symbol from a tagged message." + (let ((msg (wttrin--error-message 'wttrin-service-error "boom"))) + (should (eq 'wttrin-service-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-plain-string-is-nil () + "An untagged string has no error type." + (should (null (wttrin-error-message-type "just a string")))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-nil-is-nil () + "nil has no error type." + (should (null (wttrin-error-message-type nil)))) + +(ert-deftest test-wttrin-error-types-boundary-error-type-empty-string-is-nil () + "An empty string has no error type." + (should (null (wttrin-error-message-type "")))) + +;;; Synchronous signal site + +(ert-deftest test-wttrin-error-types-error-build-url-nil-signals-invalid-input () + "A nil query signals the specific wttrin-invalid-input condition." + (should-error (wttrin--build-url nil) :type 'wttrin-invalid-input) + (should-error (wttrin--build-url nil) :type 'wttrin-error)) + +;;; Async classification — error-msg handed to the callback carries the class + +(defun test-wttrin-error-types--capture-error-msg (status &optional status-code) + "Run the fetch callback with STATUS, return the error-msg it receives. +STATUS-CODE, when non-nil, is the HTTP status the buffer reports." + (let ((captured 'unset)) + (cl-letf (((symbol-function 'wttrin--extract-response-body) (lambda () nil)) + ((symbol-function 'wttrin--extract-http-status) (lambda () status-code)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--handle-fetch-callback + status + (lambda (_data &optional error-msg) (setq captured error-msg)))) + captured)) + +(ert-deftest test-wttrin-error-types-error-network-failure-tagged-network () + "A network-level failure tags the error-msg as wttrin-network-error." + (let ((msg (test-wttrin-error-types--capture-error-msg + '(:error (error "Network unreachable"))))) + (should (eq 'wttrin-network-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-http-404-tagged-not-found () + "An HTTP 4xx tags the error-msg as wttrin-not-found-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 404))) + (should (eq 'wttrin-not-found-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-http-500-tagged-service () + "An HTTP 5xx tags the error-msg as wttrin-service-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 500))) + (should (eq 'wttrin-service-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-2xx-empty-body-tagged-parse () + "A 2xx response with no usable body tags the error-msg as wttrin-parse-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil 200))) + (should (eq 'wttrin-parse-error (wttrin-error-message-type msg))))) + +(ert-deftest test-wttrin-error-types-error-missing-status-tagged-parse () + "An unreadable response (no status, no body) tags the error-msg as wttrin-parse-error." + (let ((msg (test-wttrin-error-types--capture-error-msg nil nil))) + (should (eq 'wttrin-parse-error (wttrin-error-message-type msg))))) + +(provide 'test-wttrin-error-types) +;;; test-wttrin-error-types.el ends here diff --git a/tests/test-wttrin-faces.el b/tests/test-wttrin-faces.el new file mode 100644 index 0000000..db30002 --- /dev/null +++ b/tests/test-wttrin-faces.el @@ -0,0 +1,26 @@ +;;; test-wttrin-faces.el --- Tests for wttrin themeable faces -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;;; Commentary: + +;; Unit tests verifying the package's customizable faces are defined so +;; themes and `customize-face' can target them. + +;;; Code: + +(require 'ert) +(require 'wttrin) + +;;; Normal Cases + +(ert-deftest test-wttrin-faces-normal-all-defined () + "Normal: every package face is defined after loading wttrin." + (dolist (face '(wttrin-mode-line-stale + wttrin-staleness-header + wttrin-instructions + wttrin-key)) + (should (facep face)))) + +(provide 'test-wttrin-faces) +;;; test-wttrin-faces.el ends here diff --git a/tests/test-wttrin-geolocation--internals.el b/tests/test-wttrin-geolocation--internals.el index 6ad8384..dfc483d 100644 --- a/tests/test-wttrin-geolocation--internals.el +++ b/tests/test-wttrin-geolocation--internals.el @@ -128,9 +128,11 @@ ;;; Error Cases (ert-deftest test-wttrin-geolocation--lookup-provider-error-unknown-symbol () - "Unknown provider symbol signals error." + "Unknown provider symbol signals the typed wttrin-invalid-input condition." (should-error (wttrin-geolocation--lookup-provider 'definitely-not-registered) - :type 'error)) + :type 'wttrin-invalid-input) + (should-error (wttrin-geolocation--lookup-provider 'definitely-not-registered) + :type 'wttrin-error)) ;;; -------------------------------------------------------------------------- ;;; wttrin-geolocation--extract-body diff --git a/tests/test-wttrin-geolocation-command.el b/tests/test-wttrin-geolocation-command.el new file mode 100644 index 0000000..40ea278 --- /dev/null +++ b/tests/test-wttrin-geolocation-command.el @@ -0,0 +1,161 @@ +;;; test-wttrin-geolocation-command.el --- Tests for the external-command geolocation provider -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the generic external-command geolocation provider: +;; `wttrin-geolocation--parse-coordinates' (pure JSON -> "LAT,LNG"), the +;; routing/fallback in `wttrin-geolocation-detect' when +;; `wttrin-geolocation-command' is set, and an end-to-end run of +;; `wttrin-geolocation--detect-via-command' against a real shell command. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'wttrin-geolocation) + +;;; wttrin-geolocation--parse-coordinates + +(ert-deftest test-wttrin-geolocation-command-normal-parse-coordinates () + "Normal: numeric lat/lng become a \"LAT,LNG\" string." + (should (equal "41.32,-71.81" + (wttrin-geolocation--parse-coordinates + "{\"lat\": 41.32, \"lng\": -71.81}")))) + +(ert-deftest test-wttrin-geolocation-command-boundary-parse-ignores-extra-keys () + "Boundary: extra keys (accuracy, address) are ignored." + (should (equal "1.5,2.5" + (wttrin-geolocation--parse-coordinates + "{\"lat\":1.5,\"lng\":2.5,\"accuracy_m\":11.5,\"address\":\"x\"}")))) + +(ert-deftest test-wttrin-geolocation-command-error-parse-malformed-json () + "Error: malformed JSON returns nil." + (should (null (wttrin-geolocation--parse-coordinates "not json"))) + (should (null (wttrin-geolocation--parse-coordinates ""))) + (should (null (wttrin-geolocation--parse-coordinates nil)))) + +(ert-deftest test-wttrin-geolocation-command-error-parse-missing-or-nonnumeric () + "Error: missing or non-numeric coordinates return nil." + (should (null (wttrin-geolocation--parse-coordinates "{\"lat\":1.0}"))) + (should (null (wttrin-geolocation--parse-coordinates + "{\"lat\":\"x\",\"lng\":\"y\"}")))) + +;;; wttrin-geolocation--parse-address + +(ert-deftest test-wttrin-geolocation-command-normal-parse-address () + "Normal: the address key is returned verbatim." + (should (equal "Westerly, Rhode Island, USA" + (wttrin-geolocation--parse-address + "{\"lat\":1.0,\"lng\":2.0,\"address\":\"Westerly, Rhode Island, USA\"}")))) + +(ert-deftest test-wttrin-geolocation-command-boundary-parse-address-label-synonym () + "Boundary: a `label' key is accepted when `address' is absent." + (should (equal "Westerly, RI" + (wttrin-geolocation--parse-address + "{\"lat\":1.0,\"lng\":2.0,\"label\":\"Westerly, RI\"}")))) + +(ert-deftest test-wttrin-geolocation-command-error-parse-address-absent () + "Error: no address or label, malformed JSON, or empty string returns nil." + (should (null (wttrin-geolocation--parse-address "{\"lat\":1.0,\"lng\":2.0}"))) + (should (null (wttrin-geolocation--parse-address "not json"))) + (should (null (wttrin-geolocation--parse-address + "{\"lat\":1.0,\"lng\":2.0,\"address\":\"\"}")))) + +;;; wttrin-geolocation-detect — routing and fallback + +(ert-deftest test-wttrin-geolocation-command-normal-detect-uses-command () + "Normal: with a command set that succeeds, its coordinates are used." + (let ((got 'none) + (ip-called nil) + (wttrin-geolocation-command "ignored-in-mock")) + (cl-letf (((symbol-function 'wttrin-geolocation--detect-via-command) + (lambda (cb) (funcall cb "1.0,2.0"))) + ((symbol-function 'wttrin-geolocation--detect-via-ip) + (lambda (cb) (setq ip-called t) (funcall cb "City, ST")))) + (wttrin-geolocation-detect (lambda (r &optional _a) (setq got r)))) + (should (equal "1.0,2.0" got)) + (should-not ip-called))) + +(ert-deftest test-wttrin-geolocation-command-boundary-detect-falls-back-to-ip () + "Boundary: with a command that fails (nil), detection falls back to IP." + (let ((got 'none) + (wttrin-geolocation-command "ignored-in-mock")) + (cl-letf (((symbol-function 'wttrin-geolocation--detect-via-command) + (lambda (cb) (funcall cb nil))) + ((symbol-function 'wttrin-geolocation--detect-via-ip) + (lambda (cb) (funcall cb "City, ST")))) + (wttrin-geolocation-detect (lambda (r &optional _a) (setq got r)))) + (should (equal "City, ST" got)))) + +(ert-deftest test-wttrin-geolocation-command-boundary-detect-no-command-uses-ip () + "Boundary: with no command set, the IP path runs directly." + (let ((got 'none) + (cmd-called nil) + (wttrin-geolocation-command nil)) + (cl-letf (((symbol-function 'wttrin-geolocation--detect-via-command) + (lambda (cb) (setq cmd-called t) (funcall cb "9.0,9.0"))) + ((symbol-function 'wttrin-geolocation--detect-via-ip) + (lambda (cb) (funcall cb "City, ST")))) + (wttrin-geolocation-detect (lambda (r &optional _a) (setq got r)))) + (should (equal "City, ST" got)) + (should-not cmd-called))) + +;;; wttrin-geolocation--detect-via-command — real process + +(defun test-wttrin-geolocation-command--run-sync (command) + "Run `wttrin-geolocation--detect-via-command' with COMMAND, wait, return coords. +The address (second callback argument) is ignored here; a separate test covers it." + (let ((result 'pending) + (wttrin-geolocation-command command)) + (wttrin-geolocation--detect-via-command + (lambda (r &optional _a) (setq result r))) + (with-timeout (5 (error "detect-via-command timed out")) + (while (eq result 'pending) + (accept-process-output nil 0.05))) + result)) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-success () + "Integration: a command printing lat/lng JSON resolves to \"LAT,LNG\". +Components: wttrin-geolocation--detect-via-command (real make-process), +the shell (real), wttrin-geolocation--parse-coordinates (real)." + (should (equal "1.5,2.5" + (test-wttrin-geolocation-command--run-sync + "echo '{\"lat\":1.5,\"lng\":2.5}'")))) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-passes-address () + "Integration: a command printing lat/lng plus an address passes both to the callback. +Components: detect-via-command (real make-process), the shell, the coord and +address parsers (real)." + (let ((coords 'pending) + (address 'pending) + (wttrin-geolocation-command + "echo '{\"lat\":1.5,\"lng\":2.5,\"address\":\"Westerly, RI\"}'")) + (wttrin-geolocation--detect-via-command + (lambda (c &optional a) (setq coords c address a))) + (with-timeout (5 (error "detect-via-command timed out")) + (while (eq coords 'pending) + (accept-process-output nil 0.05))) + (should (equal "1.5,2.5" coords)) + (should (equal "Westerly, RI" address)))) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-nonzero-exit () + "Integration: a command exiting non-zero yields nil (caller falls back to IP)." + (should (null (test-wttrin-geolocation-command--run-sync "exit 1")))) + +(ert-deftest test-wttrin-geolocation-command-integration-real-command-bad-output () + "Integration: a zero-exit command printing non-JSON yields nil." + (should (null (test-wttrin-geolocation-command--run-sync "echo not-json")))) + +(ert-deftest test-wttrin-geolocation-command-error-spawn-failure-yields-nil () + "Error: when the process cannot spawn, the callback receives nil." + (let ((result 'pending) + (wttrin-geolocation-command "whatever")) + (cl-letf (((symbol-function 'make-process) + (lambda (&rest _) (error "spawn failed")))) + (wttrin-geolocation--detect-via-command (lambda (r) (setq result r)))) + (should (null result)))) + +(provide 'test-wttrin-geolocation-command) +;;; test-wttrin-geolocation-command.el ends here diff --git a/tests/test-wttrin-geolocation-sentinel.el b/tests/test-wttrin-geolocation-sentinel.el new file mode 100644 index 0000000..169761b --- /dev/null +++ b/tests/test-wttrin-geolocation-sentinel.el @@ -0,0 +1,212 @@ +;;; test-wttrin-geolocation-sentinel.el --- Tests for the picker geolocation sentinel -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the "Current location (detect)" picker sentinel: its presence +;; and position in `wttrin--completion-candidates', the selection routing in +;; `wttrin--query-selection' (literal vs detect-then-query), and the guard that +;; keeps the sentinel out of location history. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'wttrin-geolocation) +(require 'testutil-wttrin) + +;;; wttrin--completion-candidates — sentinel presence and position + +(ert-deftest test-wttrin-geolocation-sentinel-normal-first-candidate () + "Normal: the sentinel is the first completion candidate." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Tokyo"))) + (should (equal wttrin--geolocation-sentinel + (car (wttrin--completion-candidates))))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-normal-first-even-with-favorite () + "Normal: the sentinel precedes a string favorite in the candidate list." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-favorite-location "New Orleans, LA") + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (should (equal (list wttrin--geolocation-sentinel + "New Orleans, LA" "Honolulu, HI") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +;;; wttrin--sort-completions — pin the sentinel first + +(ert-deftest test-wttrin-geolocation-sentinel-normal-sort-pins-first () + "Normal: the sentinel is moved to the front, the rest keep their order. +Sorting completion UIs (vertico, icomplete) call the metadata +display-sort-function, so this is what keeps the sentinel pinned." + (should (equal (list wttrin--geolocation-sentinel "Honolulu, HI" "Tokyo") + (wttrin--sort-completions + (list "Honolulu, HI" wttrin--geolocation-sentinel "Tokyo"))))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-sort-no-sentinel-unchanged () + "Boundary: a list without the sentinel is returned in its original order." + (should (equal '("Honolulu, HI" "Tokyo") + (wttrin--sort-completions '("Honolulu, HI" "Tokyo"))))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-sort-empty () + "Boundary: an empty candidate list sorts to empty." + (should (null (wttrin--sort-completions nil)))) + +;;; wttrin--completion-table — metadata + completion + +(ert-deftest test-wttrin-geolocation-sentinel-normal-table-metadata-sort-fn () + "Normal: the table advertises the pin-first display-sort-function." + (let* ((table (wttrin--completion-table + (list wttrin--geolocation-sentinel "Tokyo"))) + (meta (funcall table "" nil 'metadata))) + (should (eq #'wttrin--sort-completions + (cdr (assq 'display-sort-function (cdr meta))))))) + +(ert-deftest test-wttrin-geolocation-sentinel-normal-table-completes-candidates () + "Normal: the table completes over the candidates it was given." + (let ((table (wttrin--completion-table + (list wttrin--geolocation-sentinel "Tokyo" "Paris")))) + (should (equal (sort (list wttrin--geolocation-sentinel "Tokyo" "Paris") + #'string-lessp) + (sort (all-completions "" table) #'string-lessp))))) + +;;; wttrin interactive entry — delegates to routing + +(ert-deftest test-wttrin-geolocation-sentinel-normal-entry-delegates-to-query-selection () + "Normal: the interactive `wttrin' command routes its picker selection +through `wttrin--query-selection' (smoke test of the entry wrapper)." + (testutil-wttrin-setup) + (unwind-protect + (let ((routed nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "London, GB")) + ((symbol-function 'wttrin--query-selection) + (lambda (loc) (setq routed loc)))) + (call-interactively 'wttrin)) + (should (equal "London, GB" routed))) + (testutil-wttrin-teardown))) + +;;; wttrin--query-selection — routing + +(ert-deftest test-wttrin-geolocation-sentinel-normal-typed-location-queries-literally () + "Normal: a typed location is passed straight to `wttrin-query'." + (testutil-wttrin-setup) + (unwind-protect + (let ((captured nil)) + (cl-letf (((symbol-function 'wttrin-query) + (lambda (loc &rest _) (setq captured loc)))) + (wttrin--query-selection "Paris")) + (should (equal "Paris" captured))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-normal-routes-to-detect-then-query () + "Normal: selecting the sentinel detects, then queries the resolved city." + (testutil-wttrin-setup) + (unwind-protect + (let ((captured nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (callback) (funcall callback "Austin, TX"))) + ((symbol-function 'wttrin-query) + (lambda (loc &rest _) (setq captured loc))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--query-selection wttrin--geolocation-sentinel)) + (should (equal "Austin, TX" captured))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-error-detect-failure-no-query () + "Error: a failed detection does not query and does not mutate the favorite." + (testutil-wttrin-setup) + (unwind-protect + (let ((queried nil) + (wttrin-favorite-location "New Orleans, LA")) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (callback) (funcall callback nil))) + ((symbol-function 'wttrin-query) + (lambda (_loc) (setq queried t))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--query-selection wttrin--geolocation-sentinel)) + (should-not queried) + (should (equal "New Orleans, LA" wttrin-favorite-location))) + (testutil-wttrin-teardown))) + +;;; sentinel never enters history + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-never-added-to-history () + "Boundary: the sentinel string is never recorded in location history." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history wttrin--geolocation-sentinel) + (should (null wttrin--location-history))) + (testutil-wttrin-teardown))) + +;;; wttrin-geolocation-enabled — opt-out switch + +(ert-deftest test-wttrin-geolocation-sentinel-normal-disabled-hides-sentinel () + "Normal: with geolocation disabled, the sentinel is not offered." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled nil) + (wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Tokyo"))) + (should-not (member wttrin--geolocation-sentinel + (wttrin--completion-candidates))) + (should (equal '("Honolulu, HI" "Tokyo") + (wttrin--completion-candidates)))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-enabled-shows-sentinel () + "Boundary: with geolocation enabled (default), the sentinel is offered first." + (testutil-wttrin-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled t) + (wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (should (equal wttrin--geolocation-sentinel + (car (wttrin--completion-candidates))))) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-error-disabled-detect-then-query-no-detect () + "Error: with geolocation disabled, detect-then-query does not detect or query." + (testutil-wttrin-setup) + (unwind-protect + (let ((detected nil) + (queried nil) + (wttrin-geolocation-enabled nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (_cb) (setq detected t))) + ((symbol-function 'wttrin-query) + (lambda (_loc) (setq queried t))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin--detect-then-query)) + (should-not detected) + (should-not queried)) + (testutil-wttrin-teardown))) + +(ert-deftest test-wttrin-geolocation-sentinel-boundary-disabled-favorite-no-autodetect () + "Boundary: with geolocation disabled, the t-favorite auto-detect does not fire." + (testutil-wttrin-setup) + (unwind-protect + (let ((detected nil) + (wttrin-geolocation-enabled nil) + (wttrin--favorite-location-pending nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (_cb) (setq detected t)))) + (wttrin--start-favorite-location-detect)) + (should-not detected) + (should-not wttrin--favorite-location-pending)) + (testutil-wttrin-teardown))) + +(provide 'test-wttrin-geolocation-sentinel) +;;; test-wttrin-geolocation-sentinel.el ends here diff --git a/tests/test-wttrin-location-history.el b/tests/test-wttrin-location-history.el new file mode 100644 index 0000000..4af8235 --- /dev/null +++ b/tests/test-wttrin-location-history.el @@ -0,0 +1,242 @@ +;;; test-wttrin-location-history.el --- Tests for location search history -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the location search history feature: wttrin--add-to-location-history, +;; wttrin--completion-candidates, wttrin-remove-location-history, +;; wttrin-clear-location-history, and savehist integration. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) +(require 'testutil-wttrin) + +;;; Setup and Teardown + +(defun test-wttrin-location-history-setup () + "Setup: isolate history and defaults from the user's real config." + (testutil-wttrin-setup) + (setq wttrin--location-history nil)) + +(defun test-wttrin-location-history-teardown () + "Teardown: clear history." + (setq wttrin--location-history nil) + (testutil-wttrin-teardown)) + +;;; wttrin--add-to-location-history + +(ert-deftest test-wttrin-location-history-normal-adds-new-location () + "A new location is pushed onto the front of history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Tokyo") + (should (equal '("Tokyo") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-promotes-existing-to-front () + "Re-adding an existing location moves it to the front without duplicating." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history '("Paris" "Tokyo" "Berlin"))) + (wttrin--add-to-location-history "Tokyo") + (should (equal '("Tokyo" "Paris" "Berlin") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-skips-default-location () + "A location already in defaults is not added to history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Honolulu, HI") + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-trims-to-max () + "History is trimmed to `wttrin-location-history-max', keeping the most recent." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin-location-history-max 3) + (wttrin--location-history '("c" "b" "a"))) + (wttrin--add-to-location-history "d") + (should (equal '("d" "c" "b") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-empty-history () + "Adding to empty history yields a single-entry list." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Reykjavik") + (should (equal '("Reykjavik") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-max-zero-keeps-none () + "A max of 0 results in empty history after a trim." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin-location-history-max 0) + (wttrin--location-history nil)) + (wttrin--add-to-location-history "Nowhere") + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-error-nil-location-no-op () + "A nil location is a no-op." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history '("Paris"))) + (wttrin--add-to-location-history nil) + (should (equal '("Paris") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-error-empty-string-no-op () + "An empty string is a no-op." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-default-locations '()) + (wttrin--location-history '("Paris"))) + (wttrin--add-to-location-history "") + (should (equal '("Paris") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +;;; wttrin--completion-candidates + +(ert-deftest test-wttrin-location-history-normal-candidates-defaults-then-history () + "Candidates list the sentinel, then defaults, then history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history '("Tokyo" "Paris"))) + (should (equal (list wttrin--geolocation-sentinel + "Honolulu, HI" "Berkeley, CA" "Tokyo" "Paris") + (wttrin--completion-candidates)))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-candidates-only-defaults () + "With empty history, candidates are the sentinel then the defaults." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history nil)) + (should (equal (list wttrin--geolocation-sentinel "Honolulu, HI") + (wttrin--completion-candidates)))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-candidates-only-history () + "With empty defaults, candidates are the sentinel then the history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin-favorite-location nil) + (wttrin-default-locations '()) + (wttrin--location-history '("Tokyo"))) + (should (equal (list wttrin--geolocation-sentinel "Tokyo") + (wttrin--completion-candidates)))) + (test-wttrin-location-history-teardown))) + +;;; wttrin-remove-location-history + +(ert-deftest test-wttrin-location-history-normal-remove-entry () + "Removing an entry drops it from history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo" "Paris" "Berlin"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location-history "Paris")) + (should (equal '("Tokyo" "Berlin") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-remove-absent-no-op () + "Removing an entry not present leaves history unchanged." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location-history "Mars")) + (should (equal '("Tokyo") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-boundary-remove-last-leaves-empty () + "Removing the only entry leaves an empty list." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location-history "Tokyo")) + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +;;; wttrin-clear-location-history + +(ert-deftest test-wttrin-location-history-normal-clear-confirmed () + "Confirming the prompt clears all history." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo" "Paris"))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-clear-location-history)) + (should (null wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +(ert-deftest test-wttrin-location-history-normal-clear-declined-keeps-history () + "Declining the prompt leaves history intact." + (test-wttrin-location-history-setup) + (unwind-protect + (let ((wttrin--location-history '("Tokyo" "Paris"))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-clear-location-history)) + (should (equal '("Tokyo" "Paris") wttrin--location-history))) + (test-wttrin-location-history-teardown))) + +;;; savehist integration + +(ert-deftest test-wttrin-location-history-integration-savehist-registers-variable () + "Loading savehist registers wttrin--location-history for persistence." + (require 'savehist) + (should (memq 'wttrin--location-history savehist-additional-variables))) + +(ert-deftest test-wttrin-location-history-normal-savehist-register-adds-var () + "wttrin--savehist-register adds the history variable to the save list." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring))) + (wttrin--savehist-register) + (should (memq 'wttrin--location-history savehist-additional-variables)))) + +(ert-deftest test-wttrin-location-history-boundary-savehist-register-idempotent () + "Registering an already-present variable does not duplicate it." + (require 'savehist) + (require 'cl-lib) + (let ((savehist-additional-variables '(wttrin--location-history wttrin-favorite-location))) + (wttrin--savehist-register) + (should (= 1 (cl-count 'wttrin--location-history savehist-additional-variables))) + (should (= 1 (cl-count 'wttrin-favorite-location savehist-additional-variables))))) + +(ert-deftest test-wttrin-location-history-integration-savehist-register-on-save-hook () + "The registration runs on `savehist-save-hook' so it survives a clobber." + (require 'savehist) + (should (memq 'wttrin--savehist-register savehist-save-hook))) + +(ert-deftest test-wttrin-location-history-integration-savehist-survives-clobber () + "A user setq that drops the variable is repaired before the next save." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring search-ring))) + ;; simulate the save path: savehist-save runs this hook first + (run-hooks 'savehist-save-hook) + (should (memq 'wttrin--location-history savehist-additional-variables)))) + +(provide 'test-wttrin-location-history) +;;; test-wttrin-location-history.el ends here diff --git a/tests/test-wttrin-make-default.el b/tests/test-wttrin-make-default.el new file mode 100644 index 0000000..e715e12 --- /dev/null +++ b/tests/test-wttrin-make-default.el @@ -0,0 +1,176 @@ +;;; test-wttrin-make-default.el --- Tests for promote-to-default command -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;;; Commentary: + +;; Unit tests for wttrin--set-favorite-location and wttrin-make-default, +;; the weather-buffer command (bound to "d") that promotes the displayed +;; location to the persisted favorite. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) + +;;; -------------------------------------------------------------------------- +;;; wttrin--set-favorite-location +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin--set-favorite-location-normal-sets-variable () + "Normal: sets `wttrin-favorite-location' to the given location." + (let ((wttrin-favorite-location nil) + (savehist-additional-variables nil)) + (wttrin--set-favorite-location "Paris, FR") + (should (equal wttrin-favorite-location "Paris, FR")))) + +(ert-deftest test-wttrin--set-favorite-location-error-no-savehist-loaded () + "Error: setting the favorite works even when savehist is not loaded. +The setter must not touch `savehist-additional-variables' directly (it may be +unbound); persistence is left to `wttrin--savehist-register'." + (let ((wttrin-favorite-location nil)) + ;; Simulate savehist absent: the variable is unbound. + (cl-letf (((symbol-function 'wttrin--savehist-register) + (lambda () (error "Should not be called from the setter")))) + (wttrin--set-favorite-location "Oslo, NO") + (should (equal wttrin-favorite-location "Oslo, NO"))))) + +(ert-deftest test-wttrin--set-favorite-location-normal-drops-from-history () + "Normal: promoting a location removes it from the search history." + (let ((wttrin-favorite-location nil) + (wttrin--location-history '("Reykjavik" "Oslo, NO"))) + (wttrin--set-favorite-location "Reykjavik") + (should-not (member "Reykjavik" wttrin--location-history)) + (should (equal wttrin--location-history '("Oslo, NO"))))) + +(ert-deftest test-wttrin--set-favorite-location-boundary-not-in-history-is-noop () + "Boundary: promoting a location absent from history leaves history intact." + (let ((wttrin-favorite-location nil) + (wttrin--location-history '("Oslo, NO"))) + (wttrin--set-favorite-location "Berkeley, CA") + (should (equal wttrin--location-history '("Oslo, NO"))))) + +(ert-deftest test-wttrin-favorite-savehist-register-includes-favorite () + "Normal: `wttrin--savehist-register' registers the favorite for persistence." + (require 'savehist) + (let ((savehist-additional-variables '(kill-ring))) + (wttrin--savehist-register) + (should (memq 'wttrin-favorite-location savehist-additional-variables)))) + +;;; -------------------------------------------------------------------------- +;;; mode-line refresh when the favorite changes +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin--set-favorite-location-normal-mode-line-on-refreshes () + "Normal: changing the favorite while the mode-line is active clears the +stale cache and fetches fresh weather for the new location immediately." + (let ((wttrin-favorite-location "Oslo, NO") + (wttrin-mode-line-mode t) + (wttrin--mode-line-cache (cons 0.0 "Oslo, NO: sun")) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t))) + ((symbol-function 'wttrin--mode-line-set-placeholder) + (lambda () nil))) + (wttrin--set-favorite-location "Paris, FR") + (should (null wttrin--mode-line-cache)) + (should fetched)))) + +;;; Boundary Cases + +(ert-deftest test-wttrin--set-favorite-location-boundary-mode-line-off-no-fetch () + "Boundary: with the mode-line inactive, changing the favorite does not fetch." + (let ((wttrin-favorite-location "Oslo, NO") + (wttrin-mode-line-mode nil) + (fetched nil)) + (cl-letf (((symbol-function 'wttrin--mode-line-fetch-weather) + (lambda () (setq fetched t)))) + (wttrin--set-favorite-location "Paris, FR") + (should-not fetched)))) + +(ert-deftest test-wttrin--set-favorite-location-boundary-unchanged-no-fetch () + "Boundary: re-promoting the current favorite does not refetch the mode-line." + (let ((wttrin-favorite-location "Paris, FR") + (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))) + (wttrin--set-favorite-location "Paris, FR") + (should-not fetched)))) + +;;; -------------------------------------------------------------------------- +;;; wttrin-make-default +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin-make-default-normal-sets-favorite-from-current () + "Normal: promotes the buffer's current location to the favorite." + (let ((wttrin-favorite-location nil) + (savehist-additional-variables nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Tokyo, JP") + (wttrin-make-default) + (should (equal wttrin-favorite-location "Tokyo, JP"))))) + +;;; Boundary Cases + +(ert-deftest test-wttrin-make-default-boundary-nil-current-leaves-favorite () + "Boundary: no current location is a no-op that leaves the favorite intact." + (let ((wttrin-favorite-location "Berkeley, CA") + (savehist-additional-variables nil)) + (with-temp-buffer + (setq-local wttrin--current-location nil) + (wttrin-make-default) + (should (equal wttrin-favorite-location "Berkeley, CA"))))) + +;;; -------------------------------------------------------------------------- +;;; favorite in completion candidates +;;; -------------------------------------------------------------------------- + +;;; Normal Cases + +(ert-deftest test-wttrin-make-default-normal-favorite-prepended-to-candidates () + "Normal: a typed-in favorite is offered in the picker, at the front." + (let ((wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history nil) + (wttrin-favorite-location "Reykjavik")) + (should (equal (wttrin--completion-candidates) + (list wttrin--geolocation-sentinel + "Reykjavik" "Honolulu, HI" "Berkeley, CA"))))) + +;;; Boundary Cases + +(ert-deftest test-wttrin-make-default-boundary-favorite-default-not-duplicated () + "Boundary: a favorite that is already a default appears exactly once." + (require 'cl-lib) + (let ((wttrin-default-locations '("Honolulu, HI" "Berkeley, CA")) + (wttrin--location-history nil) + (wttrin-favorite-location "Berkeley, CA")) + (should (= 1 (cl-count "Berkeley, CA" (wttrin--completion-candidates) :test #'equal))))) + +(ert-deftest test-wttrin-make-default-boundary-nil-favorite-candidates-unchanged () + "Boundary: nil favorite leaves the candidate list as defaults plus history." + (let ((wttrin-default-locations '("Honolulu, HI")) + (wttrin--location-history '("Oslo, NO")) + (wttrin-favorite-location nil)) + (should (equal (wttrin--completion-candidates) + (list wttrin--geolocation-sentinel "Honolulu, HI" "Oslo, NO"))))) + +;;; -------------------------------------------------------------------------- +;;; keymap binding +;;; -------------------------------------------------------------------------- + +(ert-deftest test-wttrin-make-default-normal-d-bound-in-mode-map () + "Normal: the weather-buffer keymap binds \"d\" to the command." + (should (eq (lookup-key wttrin-mode-map (kbd "d")) 'wttrin-make-default))) + +(provide 'test-wttrin-make-default) +;;; test-wttrin-make-default.el ends here diff --git a/tests/test-wttrin-query.el b/tests/test-wttrin-query.el index 396507b..4c4de87 100644 --- a/tests/test-wttrin-query.el +++ b/tests/test-wttrin-query.el @@ -102,20 +102,17 @@ "When fetch returns nil, the user should see an error message, not a crash." (test-wttrin-query-setup) (unwind-protect - (let ((saved-callback nil) - (displayed-message nil)) - (cl-letf (((symbol-function 'wttrin--get-cached-or-fetch) - (lambda (_location callback) - (setq saved-callback callback))) - ((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) - (wttrin-query "BadLocation") - ;; Simulate fetch returning nil - (funcall saved-callback nil) - ;; Should have shown error message (from wttrin--display-weather validation) - (should displayed-message) - (should (string-match-p "Cannot retrieve" displayed-message)))) + (let ((saved-callback nil)) + (testutil-wttrin-with-captured-message displayed-message + (cl-letf (((symbol-function 'wttrin--get-cached-or-fetch) + (lambda (_location callback) + (setq saved-callback callback)))) + (wttrin-query "BadLocation") + ;; Simulate fetch returning nil + (funcall saved-callback nil) + ;; Should have shown error message (from wttrin--display-weather validation) + (should displayed-message) + (should (string-match-p "Cannot retrieve" displayed-message))))) (test-wttrin-query-teardown))) (provide 'test-wttrin-query) diff --git a/tests/test-wttrin-requery-force.el b/tests/test-wttrin-requery-force.el index d572348..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") @@ -63,15 +63,12 @@ "When no current location is set, user should be told there's nothing to refresh." (test-wttrin-requery-force-setup) (unwind-protect - (let ((displayed-message nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) - (setq displayed-message (apply #'format fmt args))))) - (with-current-buffer (get-buffer-create "*wttr.in*") - ;; wttrin--current-location is nil (buffer-local default) - (wttrin-requery-force) - (should displayed-message) - (should (string-match-p "No location" displayed-message))))) + (testutil-wttrin-with-captured-message displayed-message + (with-current-buffer (get-buffer-create "*wttr.in*") + ;; wttrin--current-location is nil (buffer-local default) + (wttrin-requery-force) + (should displayed-message) + (should (string-match-p "No location" displayed-message)))) (test-wttrin-requery-force-teardown))) (ert-deftest test-wttrin-requery-force-boundary-force-flag-does-not-leak () @@ -79,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 d6a8beb..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))) @@ -105,15 +105,22 @@ to the core requery function." (test-wttrin-requery-setup) (unwind-protect (let ((offered-collection nil) + (wttrin-favorite-location nil) + (wttrin--location-history nil) (wttrin-default-locations '("Paris" "London" "Tokyo"))) (cl-letf (((symbol-function 'completing-read) (lambda (_prompt collection &rest _args) (setq offered-collection collection) "Paris")) ((symbol-function 'wttrin--requery-location) - (lambda (_loc) nil))) + (lambda (_loc &rest _) nil))) (wttrin-requery) - (should (equal offered-collection '("Paris" "London" "Tokyo"))))) + ;; The collection is now a completion table (a function) that pins + ;; the sentinel first; check the candidates it completes over. + (should (equal (list wttrin--geolocation-sentinel + "Paris" "London" "Tokyo") + (wttrin--sort-completions + (all-completions "" offered-collection)))))) (test-wttrin-requery-teardown))) (ert-deftest test-wttrin-requery-boundary-single-default-prefills () @@ -127,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))) @@ -143,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..de97df0 --- /dev/null +++ b/tests/test-wttrin-saved-locations.el @@ -0,0 +1,418 @@ +;;; 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)) + (should (equal "1500 Sugar Bowl Dr" + (wttrin--resolve-location-query "Craig's House"))))) + +(ert-deftest test-wttrin-saved-locations-normal-d-typed-saves-to-directory () + "Normal: making a typed location the default also saves it to the directory, +so it persists as a named entry rather than only as the favorite string." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil)) + (with-temp-buffer + (setq-local wttrin--current-location "Reykjavik") + (setq-local wttrin--current-display "Reykjavik") + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (equal "Reykjavik" wttrin-favorite-location)) + (should (assoc "Reykjavik" (wttrin--saved-locations))) + (should (equal "Reykjavik" (wttrin--resolve-location-query "Reykjavik"))))) + +;;; 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))) + +;;; history stays in sync with the directory + +(ert-deftest test-wttrin-saved-locations-normal-save-drops-query-from-history () + "Normal: saving a location drops its query from history, so the place lives in +the directory only and does not also appear as a separate history candidate." + (let ((wttrin-saved-locations nil) + (wttrin--location-history '("New Orleans" "Paris"))) + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-save-location "Home" "New Orleans")) + (should-not (member "New Orleans" wttrin--location-history)) + (should (member "Paris" wttrin--location-history)))) + +(ert-deftest test-wttrin-saved-locations-normal-d-alias-drops-query-from-history () + "Normal: making an aliased location the default drops its underlying query from +history, so the place does not also linger as a separate history candidate." + (let ((wttrin-saved-locations nil) + (wttrin-favorite-location nil) + (wttrin-mode-line-mode nil) + (wttrin--location-history '("New Orleans" "Paris"))) + (with-temp-buffer + (setq-local wttrin--current-location "New Orleans") + (setq-local wttrin--current-display "Home") + (cl-letf (((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-make-default))) + (should (equal "Home" wttrin-favorite-location)) + (should (assoc "Home" (wttrin--saved-locations))) + (should-not (member "New Orleans" wttrin--location-history)) + (should (member "Paris" wttrin--location-history)))) + +(ert-deftest test-wttrin-saved-locations-normal-remove-forgets-history () + "Normal: removing a saved location drops both its name and its query from +history, so a removed place does not resurface as a history candidate." + (let ((wttrin-saved-locations '(("Home" . "New Orleans"))) + (wttrin--location-history '("Home" "New Orleans" "Paris"))) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-remove-location "Home")) + (should-not (member "Home" wttrin--location-history)) + (should-not (member "New Orleans" wttrin--location-history)) + (should (member "Paris" wttrin--location-history)))) + +(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 170d0fb..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 () @@ -118,5 +141,34 @@ messages))) (test-wttrin-set-location-from-geolocation-teardown))) +;;; Opt-out + +(ert-deftest test-wttrin-set-location-from-geolocation-boundary-disabled-no-detect () + "Boundary: with geolocation disabled, the command neither detects nor sets." + (test-wttrin-set-location-from-geolocation-setup) + (setq wttrin-favorite-location "Pre-existing, Place") + (unwind-protect + (let ((detected nil) + (wttrin-geolocation-enabled nil)) + (cl-letf (((symbol-function 'wttrin-geolocation-detect) + (lambda (_cb) (setq detected t))) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-set-location-from-geolocation)) + (should-not detected) + (should (string= "Pre-existing, Place" wttrin-favorite-location))) + (test-wttrin-set-location-from-geolocation-teardown))) + +;;; Deprecation + +(ert-deftest test-wttrin-set-location-from-geolocation-normal-marked-obsolete () + "Normal: the command is marked obsolete with a steering message. +The favorite-setting behavior is preserved (see the Normal cases above); +this only asserts the obsolescence marker so callers get a deprecation +notice steering them to the picker." + (let ((info (get 'wttrin-set-location-from-geolocation 'byte-obsolete-info))) + (should info) + ;; Option 1: a steering string, not an alias to another function. + (should (stringp (nth 0 info))))) + (provide 'test-wttrin-set-location-from-geolocation) ;;; test-wttrin-set-location-from-geolocation.el ends here diff --git a/tests/test-wttrin-use-current-location.el b/tests/test-wttrin-use-current-location.el new file mode 100644 index 0000000..4b61657 --- /dev/null +++ b/tests/test-wttrin-use-current-location.el @@ -0,0 +1,94 @@ +;;; test-wttrin-use-current-location.el --- Tests for wttrin-use-current-location -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2026 Craig Jennings + +;;; Commentary: +;; Unit tests for the `wttrin-use-current-location' command, the labeled way to +;; set `wttrin-favorite-location' to t (always auto-detect) instead of typing +;; the bare symbol. Mocks `yes-or-no-p' and `message'; touches no network. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'wttrin) + +;;; Setup and Teardown + +(defvar test-wttrin-use-current-location--saved nil + "Snapshot of `wttrin-favorite-location' restored in teardown.") + +(defun test-wttrin-use-current-location-setup () + "Snapshot `wttrin-favorite-location' and clear it." + (setq test-wttrin-use-current-location--saved wttrin-favorite-location) + (setq wttrin-favorite-location nil)) + +(defun test-wttrin-use-current-location-teardown () + "Restore `wttrin-favorite-location'." + (setq wttrin-favorite-location test-wttrin-use-current-location--saved)) + +;;; Normal Cases + +(ert-deftest test-wttrin-use-current-location-normal-confirm-sets-t () + "Normal: confirming sets the favorite to t (auto-detect)." + (test-wttrin-use-current-location-setup) + (unwind-protect + (let ((wttrin-geolocation-enabled t)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-use-current-location)) + (should (eq t wttrin-favorite-location))) + (test-wttrin-use-current-location-teardown))) + +(ert-deftest test-wttrin-use-current-location-normal-decline-leaves-unchanged () + "Normal: declining leaves the favorite untouched." + (test-wttrin-use-current-location-setup) + (setq wttrin-favorite-location "Berkeley, CA") + (unwind-protect + (let ((wttrin-geolocation-enabled t)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-use-current-location)) + (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 () + "Boundary: with geolocation disabled, no prompt and the favorite is unchanged." + (test-wttrin-use-current-location-setup) + (setq wttrin-favorite-location "Berkeley, CA") + (unwind-protect + (let ((prompted nil) + (wttrin-geolocation-enabled nil)) + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (&rest _) (setq prompted t) t)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (wttrin-use-current-location)) + (should-not prompted) + (should (equal "Berkeley, CA" wttrin-favorite-location))) + (test-wttrin-use-current-location-teardown))) + +(provide 'test-wttrin-use-current-location) +;;; test-wttrin-use-current-location.el ends here diff --git a/tests/testutil-wttrin.el b/tests/testutil-wttrin.el index 7c71a84..e4e2e4e 100644 --- a/tests/testutil-wttrin.el +++ b/tests/testutil-wttrin.el @@ -111,6 +111,20 @@ (funcall callback nil))))) ,@body)) +;;; Message Capture Helpers + +(defmacro testutil-wttrin-with-captured-message (msg-var &rest body) + "Run BODY with `message' captured into MSG-VAR. +MSG-VAR starts nil and is set to each formatted message string as `message' +is called, so after BODY it holds the last message shown (or nil if none). +Other mocks BODY needs can be set in a nested `cl-letf'." + (declare (indent 1)) + `(let ((,msg-var nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (setq ,msg-var (apply #'format fmt args))))) + ,@body))) + ;;; Mode-line Cache Helpers (defun testutil-wttrin-set-mode-line-cache (data &optional age-seconds) diff --git a/wttrin-geolocation.el b/wttrin-geolocation.el index 03b573a..9f00b7f 100644 --- a/wttrin-geolocation.el +++ b/wttrin-geolocation.el @@ -46,6 +46,11 @@ (require 'json) (require 'url) +;; For the shared error hierarchy (`wttrin-invalid-input' et al.). This is a +;; sub-module of wttrin and is only ever loaded through it, so the require is a +;; no-op in practice; it makes the dependency explicit and keeps the condition +;; symbols defined even if this file is loaded on its own. +(require 'wttrin) (defgroup wttrin-geolocation nil "IP geolocation settings for wttrin." @@ -65,6 +70,26 @@ can select them here." (const :tag "ipwho.is" ipwhois) (symbol :tag "Other (registered in wttrin-geolocation--providers)"))) +(defcustom wttrin-geolocation-command nil + "Optional shell command for higher-accuracy geolocation. +When non-nil, `wttrin-geolocation-detect' runs this command and reads its +standard output as JSON, expecting numeric `lat' and `lng' keys (any other +keys are ignored). The detected location resolves to \"LAT,LNG\", which +wttr.in accepts and echoes a place name for. + +This is the opt-in accuracy path. The command may do whatever the system +supports (a WiFi scan, a GPS read) to beat IP geolocation, and it runs +asynchronously so a multi-second lookup does not block Emacs. The package +ships no command and assumes nothing about the OS or network stack, so it is +inert until set. + +On any failure (the command is unset, exits non-zero, or prints no parseable +lat/lng), wttrin falls back to the IP provider named by +`wttrin-geolocation-provider'." + :group 'wttrin-geolocation + :type '(choice (const :tag "None (use IP provider)" nil) + (string :tag "Shell command"))) + ;;; Response Parsers ;; ;; Each parser takes a raw JSON string and returns "City, Region" or nil. @@ -142,7 +167,8 @@ by pushing onto this list; the keys become valid values for "Return the provider plist for SYMBOL. Signal an error if SYMBOL is not registered." (or (cdr (assq symbol wttrin-geolocation--providers)) - (error "Unknown wttrin-geolocation provider: %S" symbol))) + (signal 'wttrin-invalid-input + (list (format "Unknown wttrin-geolocation provider: %S" symbol))))) ;;; Fetch and Detect @@ -160,16 +186,34 @@ found. Intended for use inside a `url-retrieve' callback." (buffer-substring-no-properties (point) (point-max)) 'utf-8)))))) -(defun wttrin-geolocation-detect (callback) - "Detect current location via the configured geolocation provider. -CALLBACK is invoked asynchronously with a single argument: a -\"City, Region\" string on success, or nil on any failure (network -error, HTTP 4xx or 5xx, malformed response, missing fields, or -provider-specific rate-limit signals). - -The provider is selected by `wttrin-geolocation-provider'. Signals -an error synchronously if that value is not registered in -`wttrin-geolocation--providers'." +(defun wttrin-geolocation--parse-coordinates (json-string) + "Parse JSON-STRING for numeric `lat'/`lng'; return \"LAT,LNG\" or nil. +Any keys beyond `lat' and `lng' are ignored. Returns nil on malformed +JSON or missing/non-numeric coordinates. wttr.in accepts the \"LAT,LNG\" +form directly and echoes a place name for it." + (let ((data (wttrin-geolocation--decode-json json-string))) + (when data + (let ((lat (cdr (assq 'lat data))) + (lng (cdr (assq 'lng data)))) + (when (and (numberp lat) (numberp lng)) + (format "%s,%s" lat lng)))))) + +(defun wttrin-geolocation--parse-address (json-string) + "Return the `address' (or `label') string from JSON-STRING, or nil. +A command may include a human-readable place name alongside its +coordinates; wttrin shows it in the weather buffer. Returns nil on +malformed JSON or a missing or empty value." + (let ((data (wttrin-geolocation--decode-json json-string))) + (when data + (let ((address (or (cdr (assq 'address data)) + (cdr (assq 'label data))))) + (when (and (stringp address) (> (length address) 0)) + address))))) + +(defun wttrin-geolocation--detect-via-ip (callback) + "Detect location via the IP provider; invoke CALLBACK with the result. +CALLBACK receives a \"City, Region\" string on success or nil on failure. +The provider is selected by `wttrin-geolocation-provider'." (let* ((provider (wttrin-geolocation--lookup-provider wttrin-geolocation-provider)) (url (plist-get provider :url)) @@ -186,5 +230,53 @@ an error synchronously if that value is not registered in (ignore-errors (kill-buffer (current-buffer))) (funcall callback result)))))) +(defun wttrin-geolocation--detect-via-command (callback) + "Run `wttrin-geolocation-command' asynchronously; invoke CALLBACK with result. +CALLBACK is called with (COORDS ADDRESS): COORDS is a \"LAT,LNG\" string when +the command exits zero and prints JSON with numeric `lat'/`lng', and ADDRESS +is the optional human-readable place name from the JSON (nil when absent). +On any failure (spawn error, non-zero exit, or unparseable output) CALLBACK +is called with nil." + (let ((output "")) + (condition-case nil + (make-process + :name "wttrin-geolocation" + :command (list shell-file-name shell-command-switch + wttrin-geolocation-command) + :connection-type 'pipe + :noquery t + :filter (lambda (_proc chunk) (setq output (concat output chunk))) + :sentinel (lambda (proc _event) + (when (memq (process-status proc) '(exit signal)) + (let* ((ok (eq (process-exit-status proc) 0)) + (coords (and ok (wttrin-geolocation--parse-coordinates + output))) + (address (and coords + (wttrin-geolocation--parse-address + output)))) + (funcall callback coords address))))) + (error (funcall callback nil))))) + +(defun wttrin-geolocation-detect (callback) + "Detect current location; invoke CALLBACK asynchronously with the result. +CALLBACK is called with (LOCATION &optional ADDRESS). LOCATION is a location +string (\"City, Region\" from an IP provider, or \"LAT,LNG\" from a command) on +success, or nil on any failure. ADDRESS is the optional human-readable place +name a command may supply alongside coordinates (always nil on the IP path). +Callers that only need the location may accept a single argument. + +When `wttrin-geolocation-command' is non-nil, run it first; on success its +coordinates (and address, if any) are used, and on failure detection falls back +to the IP provider named by `wttrin-geolocation-provider'. When no command is +set, the IP provider is used directly. Signals an error synchronously if +`wttrin-geolocation-provider' is not registered and the IP path is reached." + (if wttrin-geolocation-command + (wttrin-geolocation--detect-via-command + (lambda (coords &optional address) + (if coords + (funcall callback coords address) + (wttrin-geolocation--detect-via-ip callback)))) + (wttrin-geolocation--detect-via-ip callback))) + (provide 'wttrin-geolocation) ;;; wttrin-geolocation.el ends here @@ -57,6 +57,39 @@ :prefix "wttrin-" :group 'comm) +(defface wttrin-mode-line-stale + '((t :inherit shadow)) + "Face for the mode-line weather emoji when its data is stale. +Applied when a scheduled refresh has failed and the cached reading is +older than twice `wttrin-mode-line-refresh-interval'. A color emoji +font may ignore the foreground, in which case the dimming is only +visible on monochrome glyphs." + :group 'wttrin) + +(defface wttrin-staleness-header + '((t :inherit shadow)) + "Face for the \"Last updated: ...\" line in the weather buffer." + :group 'wttrin) + +(defface wttrin-instructions + '((t :inherit shadow)) + "Face for the key-hint footer prose in the weather buffer." + :group 'wttrin) + +(defface wttrin-key + '((t :inherit bold)) + "Face for the bracketed key chords in the weather buffer footer. +`help-key-binding' would be the natural parent, but it only exists in +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 @@ -142,6 +175,16 @@ When cache reaches `wttrin-cache-max-entries', remove the oldest 20% to avoid frequent cleanup cycles. This value (0.20) means remove 1/5 of entries, providing a reasonable buffer before the next cleanup.") +(defcustom wttrin-geolocation-enabled t + "Whether geolocation features are available. +When non-nil (the default), the \"Current location (detect)\" entry is +offered in the picker, the `wttrin-favorite-location' = t auto-detect +runs, and the geolocation command works. Set to nil to opt out: no +geolocation surface is offered and no detection request is made. +Geolocation is on by default; you opt out, you never have to opt in." + :group 'wttrin + :type 'boolean) + (defcustom wttrin-favorite-location nil "Favorite location to display weather for. @@ -161,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: + + ((\"Superdome\" . \"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 @@ -172,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 @@ -195,11 +257,12 @@ On success the resolved string is stored in `wttrin--resolved-favorite-location'. Failures (network error, parse error) leave the cache empty and clear the pending flag, so the next call retries." - (unless wttrin--favorite-location-pending + (when (and wttrin-geolocation-enabled + (not wttrin--favorite-location-pending)) (setq wttrin--favorite-location-pending t) (require 'wttrin-geolocation) (wttrin-geolocation-detect - (lambda (location) + (lambda (location &optional _address) (setq wttrin--favorite-location-pending nil) (when location (setq wttrin--resolved-favorite-location location) @@ -208,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. @@ -349,10 +415,43 @@ Returns \"just now\" for <60s, \"X minutes ago\", \"X hours ago\", or \"X days a (concat "?" wttrin-unit-system) "?")) +;;; Error Types + +;; A small condition hierarchy so callers can branch on the *class* of a +;; failure instead of matching message text. `wttrin-error' is the parent. +;; Synchronous code paths signal these directly; the async fetch path tags its +;; human-readable error string with the class via the `wttrin-error-type' text +;; property (see `wttrin--error-message'), so two-arg callbacks keep working +;; while callers that care can read the class. + +(define-error 'wttrin-error "wttrin error") +(define-error 'wttrin-invalid-input "Invalid input" 'wttrin-error) +(define-error 'wttrin-network-error "Network error" 'wttrin-error) +(define-error 'wttrin-not-found-error "Location not found" 'wttrin-error) +(define-error 'wttrin-service-error "Weather service error" 'wttrin-error) +(define-error 'wttrin-parse-error "Could not parse weather response" 'wttrin-error) + +(defun wttrin--error-message (type format-string &rest args) + "Format an error message of class TYPE. +Return the string built from FORMAT-STRING and ARGS with TYPE stored in its +`wttrin-error-type' text property. This lets the async fetch path hand a +plain string to callbacks while still carrying the error class; read it back +with `wttrin-error-message-type'." + (propertize (apply #'format format-string args) 'wttrin-error-type type)) + +(defun wttrin-error-message-type (error-msg) + "Return the error-class symbol carried by ERROR-MSG, or nil. +ERROR-MSG is a string produced by wttrin's async fetch path; its class is +stored in the `wttrin-error-type' text property. A plain, empty, or nil +ERROR-MSG has no class." + (and (stringp error-msg) + (> (length error-msg) 0) + (get-text-property 0 'wttrin-error-type error-msg))) + (defun wttrin--build-url (query) "Build wttr.in URL for QUERY with configured parameters." (when (null query) - (error "Query cannot be nil")) + (signal 'wttrin-invalid-input '("Query cannot be nil"))) (concat "https://wttr.in/" (url-hexify-string query) (wttrin-additional-url-params) @@ -407,22 +506,33 @@ description of what went wrong, or nil on success." ((plist-get status :error) (wttrin--debug-log "wttrin--handle-fetch-callback: Network error - %s" (cdr (plist-get status :error))) - (setq error-msg "Network error — check your connection") + (setq error-msg (wttrin--error-message + 'wttrin-network-error + "Network error — check your connection")) (message "wttrin: %s" error-msg)) ;; HTTP response received — extract body (returns nil for non-2xx) (t (let ((http-status (wttrin--extract-http-status))) (setq data (wttrin--extract-response-body)) - (when (and (not data) http-status) + (when (not data) (setq error-msg (cond + ((null http-status) + (wttrin--error-message + 'wttrin-parse-error "Could not read weather response")) ((and (>= http-status 400) (< http-status 500)) - (format "Location not found (HTTP %d)" http-status)) + (wttrin--error-message + 'wttrin-not-found-error "Location not found (HTTP %d)" http-status)) ((>= http-status 500) - (format "Weather service error (HTTP %d)" http-status)) - (t (format "Unexpected HTTP status %d" http-status)))) - (when error-msg - (message "wttrin: %s" error-msg)))))) + (wttrin--error-message + 'wttrin-service-error "Weather service error (HTTP %d)" http-status)) + ((< http-status 300) + (wttrin--error-message + 'wttrin-parse-error "Could not parse weather response (HTTP %d)" http-status)) + (t + (wttrin--error-message + 'wttrin-error "Unexpected HTTP status %d" http-status)))) + (message "wttrin: %s" error-msg))))) (condition-case err (progn (wttrin--debug-log "wttrin--handle-fetch-callback: Calling user callback with %s" @@ -450,17 +560,328 @@ Handles header skipping, UTF-8 decoding, and error handling automatically." CALLBACK is called with the weather data string when ready, or nil on error." (wttrin--fetch-url (wttrin--build-url query) callback)) +;;; Location Search History + +(defcustom wttrin-location-history-max 20 + "Maximum number of entries to keep in location search history. +When the history exceeds this limit, the oldest entries are removed." + :group 'wttrin + :type 'integer) + +(defvar wttrin--location-history nil + "History of successfully searched locations, most recent first. +Persisted across sessions via `savehist-mode'.") + +;; Declared so the byte-compiler doesn't warn; savehist defines it for real. +(defvar savehist-additional-variables) + +(defun wttrin--savehist-register () + "Ensure wttrin's persisted variables are saved by savehist. +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-saved-locations)) + +(with-eval-after-load 'savehist + (wttrin--savehist-register) + (add-hook 'savehist-save-hook #'wttrin--savehist-register)) + +(defconst wttrin--geolocation-sentinel "Current location (detect)" + "Picker candidate that triggers geolocation detection. +Selecting it routes through `wttrin--query-selection' to a +detect-then-query flow instead of being treated as a literal place +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, 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 (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))) + (when (> (length wttrin--location-history) max) + (setq wttrin--location-history + (butlast wttrin--location-history + (- (length wttrin--location-history) max))))))) + +(defun wttrin--drop-from-location-history (&rest locations) + "Remove each non-nil string in LOCATIONS from `wttrin--location-history'. +Keeps the directory and the history disjoint: a place lives in one or the +other, never both." + (dolist (location locations) + (when (and location (stringp location)) + (setq wttrin--location-history + (delete location wttrin--location-history))))) + +(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 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 deduped) + deduped))) + +(defun wttrin--sort-completions (candidates) + "Return CANDIDATES with the geolocation sentinel pinned first. +The remaining candidates keep the order `wttrin--completion-candidates' +produced (favorite, defaults, then history). Used as the completion +metadata `display-sort-function' so sorting UIs (vertico, icomplete, the +default *Completions* buffer) keep the sentinel at the top instead of +re-sorting it into alphabetical position." + (if (member wttrin--geolocation-sentinel candidates) + (cons wttrin--geolocation-sentinel + (remove wttrin--geolocation-sentinel candidates)) + candidates)) + +(defun wttrin--completion-table (candidates) + "Return a completion table over CANDIDATES that pins the sentinel first. +The table answers the `metadata' action with a `display-sort-function' +of `wttrin--sort-completions', and otherwise completes over CANDIDATES. +Wrapping the list this way is what keeps the sentinel first across +completion frameworks that impose their own sort order." + (lambda (string predicate action) + (if (eq action 'metadata) + `(metadata (display-sort-function . ,#'wttrin--sort-completions)) + (complete-with-action action candidates string predicate)))) + +(defun wttrin--detect-then-query () + "Detect the current location asynchronously, then query weather for it. +No-op with a message when `wttrin-geolocation-enabled' is nil. On detection +failure, show an actionable message and leave the favorite untouched; the user +can fall back to typing a city in the picker." + (if (not wttrin-geolocation-enabled) + (message "Geolocation is disabled (set wttrin-geolocation-enabled to enable it)") + (require 'wttrin-geolocation) + (message "Detecting location...") + (wttrin-geolocation-detect + (lambda (location &optional address) + (if location + (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 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 (wttrin--resolve-location-query selection) selection))) + +(defun wttrin-remove-location-history (location) + "Remove LOCATION from the search history. +Prompts with completion over the current history entries." + (interactive + (list (completing-read "Remove from history: " + wttrin--location-history nil t))) + (setq wttrin--location-history (delete location wttrin--location-history)) + (message "Removed '%s' from location history" location)) + +(defun wttrin-clear-location-history () + "Clear all location search history." + (interactive) + (when (yes-or-no-p "Clear all location search history? ") + (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))) + (wttrin--drop-from-location-history saved 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)) + (let ((query (cdr (assoc name (wttrin--saved-locations))))) + (wttrin--remove-saved-location name) + (wttrin--drop-from-location-history name query)) + (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*") (kill-buffer "*wttr.in*")) - (wttrin-query new-location)) + (wttrin--query-selection new-location)) (defun wttrin-requery () "Kill buffer and requery wttrin." (interactive) (let ((new-location (completing-read - "Location Name: " wttrin-default-locations nil nil + "Location Name: " + (wttrin--completion-table (wttrin--completion-candidates)) + nil nil (when (= (length wttrin-default-locations) 1) (car wttrin-default-locations))))) (wttrin--requery-location new-location))) @@ -469,6 +890,10 @@ CALLBACK is called with the weather data string when ready, or nil on error." (let ((map (make-sparse-keymap))) (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.") @@ -520,10 +945,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 user instructions at bottom of current buffer." + "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\nPress: [a] for another location [g] to refresh [q] to quit")) + (insert "\n\n") + (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. @@ -536,60 +1003,91 @@ Looks up the cache timestamp for LOCATION and formats a line like (age (- (float-time) timestamp)) (time-str (format-time-string "%l:%M %p" (seconds-to-time timestamp))) (age-str (wttrin--format-age age))) - (format "Last updated: %s (%s)" (string-trim time-str) age-str))))) - -(defun wttrin--display-weather (location-name raw-string &optional error-msg) - "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 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?")) - (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 ((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) - "Asynchronously query weather of LOCATION-NAME, display result when ready." + (propertize (format "Last updated: %s (%s)" (string-trim time-str) age-str) + 'face 'wttrin-staleness-header))))) + +(defun wttrin--format-location-line (address) + "Return a propertized \"Location: ADDRESS\" line, or nil when ADDRESS is empty. +Shown in the weather buffer when a geolocation command supplied a human-readable +place name alongside its coordinates, so the resolved location is recognizable +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 (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))))))) + (wttrin--display-weather query raw-string error-msg display address))))))) (defun wttrin--make-cache-key (location) "Create cache key from LOCATION and current settings." @@ -654,33 +1152,67 @@ This creates headroom to avoid frequent cleanups." "Detect your location via IP geolocation and set it as the favorite. Uses the provider named by `wttrin-geolocation-provider' to fetch \"City, Region\", asks for confirmation, and on yes assigns the -result to `wttrin-favorite-location' for this session. +result to `wttrin-favorite-location'. -To persist the setting across Emacs sessions, either run -\\[customize-save-variable] on `wttrin-favorite-location', or add -\(setq wttrin-favorite-location ...\) to your init file. +With `savehist-mode' on, the favorite persists across sessions +automatically (wttrin registers it with savehist); no +`customize-save-variable' step is needed. IP-based geolocation can be wrong behind a VPN or a mobile hotspot. The confirmation prompt shows the detected location so you can -reject inaccurate results." +reject inaccurate results. + +This command is obsolete. Prefer the \"Current location (detect)\" +entry in \\[wttrin], then press `d' in the weather buffer to keep +the detected city as your default." (interactive) - (require 'wttrin-geolocation) - (message "Detecting location...") - (wttrin-geolocation-detect - (lambda (location) - (cond - ((null location) - (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) - (message "Set wttrin-favorite-location to: %s. Run M-x customize-save-variable to persist." - location)) - (t - (message "Location detection cancelled")))))) + (if (not wttrin-geolocation-enabled) + (message "Geolocation is disabled (set wttrin-geolocation-enabled to enable it)") + (require 'wttrin-geolocation) + (message "Detecting location...") + (wttrin-geolocation-detect + (lambda (location) + (cond + ((null location) + (message "Could not detect location (network or provider error)")) + ((yes-or-no-p (format "Detected location: %s. Set as favorite? " + location)) + (wttrin--set-favorite-location location) + (message "Set wttrin-favorite-location to: %s%s" + location + (if (bound-and-true-p savehist-mode) + " (persisted via savehist)." + ". Enable savehist-mode to persist it across sessions."))) + (t + (message "Location detection cancelled"))))))) + +(make-obsolete + 'wttrin-set-location-from-geolocation + "use the \"Current location (detect)\" entry in `wttrin', then press `d' to keep it as the default." + "0.4.0") -(defvar-local wttrin--current-location nil - "Current location displayed in this weather buffer.") +;;;###autoload +(defun wttrin-use-current-location () + "Make your current location the persistent favorite (always auto-detect). +Sets `wttrin-favorite-location' to t after confirmation, so the mode-line +and buffer track wherever you are via geolocation rather than a fixed city. +This is the labeled way to choose auto-detect without typing the bare symbol +t into your init. + +With `savehist-mode' on, the choice persists across sessions automatically. +Does nothing when `wttrin-geolocation-enabled' is nil." + (interactive) + (cond + ((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)? ") + (wttrin--set-favorite-location t) + (message "Favorite location set to auto-detect%s" + (if (bound-and-true-p savehist-mode) + " (persisted via savehist)." + ". Enable savehist-mode to persist it across sessions."))) + (t + (message "Cancelled")))) (defun wttrin-requery-force () "Force refresh weather data for current location, bypassing cache." @@ -688,9 +1220,57 @@ reject inaccurate results." (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) + "Set `wttrin-favorite-location' to LOCATION and drop it from search history. +LOCATION becomes a permanent default, so it no longer needs a history entry, +mirroring how `wttrin-default-locations' entries are kept out of history. +Persistence is handled by `wttrin--savehist-register', which registers the +variable when savehist loads and again on `savehist-save-hook', so the value +survives restarts without the Emacs custom-variable mechanism, and setting it +here works whether or not savehist is loaded." + (let ((changed (not (equal location wttrin-favorite-location)))) + (setq wttrin-favorite-location location) + (setq wttrin--location-history (delete location wttrin--location-history)) + (when (and changed (bound-and-true-p wttrin-mode-line-mode)) + (wttrin--mode-line-refresh-now)))) + +(defun wttrin-make-default () + "Make the location shown in this buffer the favorite (persisted) default. +A named buffer (a saved alias or a typed location) is saved to the directory and +promoted, so the default also persists as a named entry rather than only the +favorite string. A raw coordinate buffer (a fresh geolocation detection) first +prompts for a name, prefilled with the detected address; the entered name is +saved and promoted. An empty name keeps the raw coordinates as the default +without saving a directory entry. No-op with a message when the buffer has no +current location." + (interactive) + (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) + (wttrin--drop-from-location-history name wttrin--current-location) + (message "wttrin: %s is now the default location" name)))) + (t + (let ((favorite (or wttrin--current-display wttrin--current-location))) + (wttrin--put-saved-location favorite wttrin--current-location) + (wttrin--set-favorite-location favorite) + (wttrin--drop-from-location-history favorite wttrin--current-location) + (message "wttrin: %s is now the default location" favorite))))) + ;;; Mode-line weather display (defun wttrin--replace-response-location (response location) @@ -701,19 +1281,19 @@ user's original casing so tooltips display what the user expects." (concat location (substring response (match-beginning 0))) response)) -(defun wttrin--make-emoji-icon (emoji &optional foreground) - "Create EMOJI string with optional font face and FOREGROUND color. -Uses `wttrin-mode-line-emoji-font' when configured. -Omits `:foreground' from the face plist when FOREGROUND is nil — a literal -`:foreground nil' entry triggers \"Invalid face attribute\" warnings on every +(defun wttrin--make-emoji-icon (emoji &optional face) + "Create EMOJI string, optionally styled with FACE and the emoji font. +Uses `wttrin-mode-line-emoji-font' when configured. FACE, when non-nil, +is applied via `:inherit'. Omitting it avoids a literal `:inherit nil' +entry, which triggers \"Invalid face attribute\" warnings on every redisplay." (if wttrin-mode-line-emoji-font (propertize emoji 'face `(:family ,wttrin-mode-line-emoji-font :height 1.0 - ,@(when foreground (list :foreground foreground)))) - (if foreground - (propertize emoji 'face (list :foreground foreground)) + ,@(when face (list :inherit face)))) + (if face + (propertize emoji 'face (list :inherit face)) emoji))) (defun wttrin--set-mode-line-string (icon tooltip) @@ -772,10 +1352,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 @@ -839,7 +1420,7 @@ shows staleness info in tooltip." emoji stale-p) (setq wttrin--mode-line-rendered-stale stale-p) (setq wttrin-mode-line-string - (propertize (concat " " (wttrin--make-emoji-icon emoji (when stale-p "gray60"))) + (propertize (concat " " (wttrin--make-emoji-icon emoji (when stale-p 'wttrin-mode-line-stale))) 'help-echo #'wttrin--mode-line-tooltip 'mouse-face 'mode-line-highlight 'local-map wttrin--mode-line-map))))) @@ -868,6 +1449,16 @@ Force-refresh cache and update tooltip without opening buffer." (format "Fetching weather for %s..." (or (wttrin--favorite-location-display-name) "favorite")))) +(defun wttrin--mode-line-refresh-now () + "Discard the cached mode-line weather and fetch fresh data immediately. +Called when `wttrin-favorite-location' changes so the mode-line stops +showing the previous location's weather instead of waiting for the next +scheduled refresh." + (setq wttrin--mode-line-cache nil) + (setq wttrin--mode-line-rendered-stale nil) + (wttrin--mode-line-set-placeholder) + (wttrin--mode-line-fetch-weather)) + (defvar wttrin--buffer-refresh-timer nil "Timer object for proactive buffer cache refresh.") @@ -964,10 +1555,12 @@ When enabled, shows weather for `wttrin-favorite-location'." Weather data is fetched asynchronously to avoid blocking Emacs." (interactive (list - (completing-read "Location Name: " wttrin-default-locations nil nil + (completing-read "Location Name: " + (wttrin--completion-table (wttrin--completion-candidates)) + nil nil (when (= (length wttrin-default-locations) 1) (car wttrin-default-locations))))) - (wttrin-query location)) + (wttrin--query-selection location)) (when wttrin-mode-line-auto-enable (wttrin-mode-line-mode 1)) |
