diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,8 +1,17 @@ # fontwhich releases +## 0.3 (2026-03-27) +- improve no coverage logic +- when no font output --unicode data +- for --language check that primary font has coverage +- check normalized lang is in fontconfig orth list +- new pango --sample-text option with --language +- add --list-langs option to list all fc orths +- add --all-langs which iterates over all orth langs + ## 0.2.1 (2026-03-26) - check and warn about characters without font coverage -- output base font name when not text given +- output base font name when no text given ## 0.2 (2026-03-12) - add --unicode for unicode data output (uses `unicode-data`) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ `$ fontwhich --version` ``` -0.2.1 +0.3 ``` `$ fontwhich --help` @@ -19,18 +19,23 @@ ``` fontwhich -Usage: fontwhich [--version] [-f|--font FONT] [-l|--lang LANG] [-b|--utf8] - [-u|--unicode] [TEXT] +Usage: fontwhich [--version] [-f|--font FONT] [-b|--utf8] [-u|--unicode] + [-s|--sample-text] + (--list-langs | (-l|--lang LANG) | --all-langs | TEXT) Describes the fonts used to render text with pango + https://github.com/juhp/fontwhich#readme Available options: -h,--help Show this help text --version Show version -f,--font FONT Base font [default: Sans] - -l,--lang LANG Language code -b,--utf8 Output UTF-8 hex codes -u,--unicode Output Unicode data + -s,--sample-text Use Pango sample text for language + --list-langs List language orthography + -l,--lang LANG Language code + --all-langs Output all orth languages ``` `$ fontwhich Hello 🌍 World δΈ–η•Œ` @@ -42,19 +47,18 @@ 'δΈ–η•Œ' : Noto Sans CJK JP ``` -`$ fontwhich -f Serif "こんにけは πŸ˜€ δΈ–η•Œ"` +`$ fontwhich -f Serif "δΈ–η•Œγ“γ‚“γ«γ‘γ―πŸ˜€"` ``` -'こんにけは ' : Noto Serif CJK JP -'πŸ˜€' : Noto Color Emoji -' ' : Noto Serif CJK JP 'δΈ–η•Œ' : Noto Serif CJK JP +'こんにけは' : Noto Serif CJK JP +'πŸ˜€' : Noto Color Emoji ``` `$ fontwhich -l ja` ``` -Primary Sans font for ja is: "Noto Sans CJK JP" +Primary Sans font for 'ja': "Noto Sans CJK JP" ``` `$ fontwhich --utf8 🌳` @@ -78,12 +82,12 @@ One can use both options together: -`$ fontwhich --utf8 🍊 --unicode` +`$ fontwhich --utf8 🌸 --unicode` ``` 4 bytes; -'🍊' [f0 9f 8d 8a] : Noto Color Emoji -🍊 : TANGERINE [Common] +'🌸' [f0 9f 8c b8] : Noto Color Emoji +🌸 : CHERRY BLOSSOM [Common] ``` @@ -92,8 +96,8 @@ C library dependencies: -- Fedora: cairo-devel pango-devel gobject-introspection-devel -- Ubuntu: libcairo2-dev libpango1.0-dev libgirepository1.0-dev +- Fedora: cairo-gobject-devel gobject-introspection-devel pango-devel +- Ubuntu: libcairo2-dev libgirepository1.0-dev libpango1.0-dev Then: ``` @@ -107,11 +111,11 @@ There is a copr repo: ## Misc -Code assisted with Gemini 3.1. +Initial code assisted with Gemini 3.1. -The tool is related conceptually to (C codebase). +The tool is related conceptually to the C project . -"fontwhich" as in "sandwhich" but with fonts. +"fontwhich" as in "sandwich" but with fonts. ## Collaborate diff --git a/fontwhich.cabal b/fontwhich.cabal --- a/fontwhich.cabal +++ b/fontwhich.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: fontwhich -version: 0.2.1 +version: 0.3 synopsis: Determine fonts used to render text description: Fontwhich is a commandline tool that used pango to determine which diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,88 +1,124 @@ --- SPDX-License-Identifier: BSD-3-Clause +-- SPDX-License-Identifier: GPL-3.0-or-later -import Control.Monad.Extra (filterM, forM_, when, whenJust) +import Control.Monad.Extra (filterM, forM_, unless, when, whenJust) import qualified Data.ByteString as B -import Data.Char (ord) -import Data.Maybe (fromMaybe) +import Data.Char (isAsciiLower, ord) +import Data.List (singleton) +import Data.Maybe (fromMaybe, isNothing) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified GI.Pango as Pango import qualified GI.PangoCairo.Interfaces.FontMap as PangoCairo import SimpleCmd (error', (+-+)) -import SimpleCmdArgs hiding (str) -import System.Environment (getArgs, withArgs) +import SimpleCmdArgs (flagLongWith', optional, simpleCmdArgs, some, strArg, + strOptionWith, switchWith, (<|>)) import Text.Printf (printf) import qualified Unicode.Char.General.Names as UN import qualified Unicode.Char.General.Scripts as US import Paths_fontwhich (version) -main :: IO () -main = do - args <- getArgs - if null args - then withArgs ["--help"] main' - else main' +data Mode = ListLangs + | Lang !String + | AllLangs + | InputText ![String] -main' :: IO () -main' = +main :: IO () +main = simpleCmdArgs (Just version) "fontwhich" - "Describes the fonts used to render text with pango" $ - run + ("Describes the fonts used to render text with pango" +-+ + "https://github.com/juhp/fontwhich#readme") $ + runMain <$> optional (strOptionWith 'f' "font" "FONT" "Base font [default: Sans]") - <*> optional (strOptionWith 'l' "lang" "LANG" "Language code") <*> switchWith 'b' "utf8" "Output UTF-8 hex codes" <*> switchWith 'u' "unicode" "Output Unicode data" - <*> many (strArg "TEXT") + <*> switchWith 's' "sample-text" "Use Pango sample text for language" + <*> modeOpt + where + modeOpt = + flagLongWith' ListLangs "list-langs" "List language orthography" <|> + Lang <$> strOptionWith 'l' "lang" "LANG" "Language code" <|> + flagLongWith' AllLangs "all-langs" "Output all orth languages" <|> + InputText <$> some (strArg "TEXT") -run :: Maybe String -> Maybe String -> Bool -> Bool -> [String] -> IO () -run mfont mlang hex unicode txt = do +runMain :: Maybe String -> Bool -> Bool -> Bool -> Mode -> IO () +runMain mfont hex unicode sample mode = do -- Get a default Font Map and Context fontMap <- PangoCairo.fontMapGetDefault context <- Pango.fontMapCreateContext fontMap - attr <- Pango.attrListNew let baseName = fromMaybe "Sans" mfont baseFont <- Pango.fontDescriptionFromString $ T.pack baseName - mplang <- Pango.languageFromString $ T.pack <$> mlang + runMode fontMap context baseName baseFont mode + where + runMode fontMap context baseName baseFont mode' = + case mode' of + ListLangs -> do + putStrLn $ unwords orths + InputText args -> run args Nothing + Lang lang -> do + (plang,code) <- determineLangCode lang + t <- + if sample + -- for few langs we get itemization (eg ja) + then words . T.unpack <$> Pango.languageGetSampleString (Just plang) + else return [] + -- FIXME with iso-codes json + gettext perhaps + -- Just LangName -> return ["To be implemented!"] + run t $ Just (plang,code) + AllLangs -> + forM_ orths $ \orth -> do + when sample $ putStr $ quoteStr orth ++ ": " + runMode fontMap context baseName baseFont $ Lang orth + where + run txt mlangcode= do + if null txt then do + case mlangcode of + Nothing -> error' "no language or text string specified" + Just (plang,langcode) -> do + mfontset <- Pango.fontMapLoadFontset fontMap context baseFont plang + case mfontset of + Nothing -> error' "no fontset found" + Just fs -> do + -- Get the first (primary) font in the fontset + -- 'fontsetForeach' is the standard way to inspect them + -- For a quick check, we can just look at the primary result + -- In many cases, we want to see the first font that Pango resolves + Pango.fontsetForeach fs $ \_ font -> do + desc' <- Pango.fontDescribe font + mfamily <- Pango.fontDescriptionGetFamily desc' + whenJust mfamily $ \family -> do + mlangs <- Pango.fontGetLanguages font + let missing = + case mlangs of + Nothing -> "" + Just langs -> + if plang `elem` langs + then "" + else parenStr "missing coverage" + putStrLn $ "Primary" +-+ baseName +-+ "font for" +-+ quoteStr langcode ++ ":" +-+ show family +-+ missing + return True -- stop after first font + else do + let myText = T.pack $ unwords txt - if null txt then do - case mplang of - Nothing -> error' "no language determined" - Just plang -> do - maybeFontset <- Pango.fontMapLoadFontset fontMap context baseFont plang - case maybeFontset of - Nothing -> error' "no fontset found" - Just fs -> do - -- Get the first (primary) font in the fontset - -- 'fontsetForeach' is the standard way to inspect them - -- For a quick check, we can just look at the primary result - -- In many cases, we want to see the first font that Pango resolves - Pango.fontsetForeach fs $ \_ font -> do - desc' <- Pango.fontDescribe font - mfamily <- Pango.fontDescriptionGetFamily desc' - whenJust mfamily $ \family -> - putStrLn $ "Primary" +-+ baseName +-+ "font" +-+ maybe "" ("for" +-+) mlang +-+ "is:" +-+ show family - return True -- stop after first font - else do - let myText = T.pack $ unwords txt + Pango.contextSetFontDescription context $ Just baseFont + Pango.contextSetLanguage context (fst <$> mlangcode) - Pango.contextSetFontDescription context $ Just baseFont - Pango.contextSetLanguage context mplang + let utf8Bytes = TE.encodeUtf8 myText + when (hex || unicode) $ + putStr $ show (B.length utf8Bytes) +-+ "bytes;" - let utf8Bytes = TE.encodeUtf8 myText - when (hex || unicode) $ - putStr $ show (B.length utf8Bytes) +-+ "bytes;" + attr <- Pango.attrListNew + -- start_index, length, cached_iter + items <- Pango.itemize context myText 0 (fromIntegral $ B.length utf8Bytes) attr Nothing + when (hex || unicode) $ + putStrLn $ + if length items > 1 + then ' ' : show (length items) +-+ "pango items" + else "" + mapM (itemString utf8Bytes) items >>= + -- FIXME gather by font (eg for Japanese scripts) + mapM_ (printItemInfo hex unicode) - -- start_index, length, cached_iter - items <- Pango.itemize context myText 0 (fromIntegral $ B.length utf8Bytes) attr Nothing - when (hex || unicode) $ - putStrLn $ - if length items > 1 - then ' ' : show (length items) +-+ "pango items" - else "" - mapM (itemString utf8Bytes) items >>= - mapM_ (printItemInfo hex unicode) - where itemString :: B.ByteString -> Pango.Item -> IO (String, Pango.Item) itemString utf8Bytes item = do -- Offsets in Pango are bytes @@ -91,9 +127,16 @@ let itemBytes = B.take (fromIntegral len) $ B.drop (fromIntegral offset) utf8Bytes return (T.unpack $ TE.decodeUtf8 itemBytes, item) +surround :: Char -> Char -> String -> String +surround o c s = + o : s ++ singleton c + quoteStr :: String -> String -quoteStr str = '\'' : str ++ "'" +quoteStr = surround '\'' '\'' +parenStr :: String -> String +parenStr = surround '(' ')' + printItemInfo :: Bool -> Bool -> (String, Pango.Item) -> IO () printItemInfo hex unicode (str,item) = do -- Get the Analysis struct from the Item @@ -105,31 +148,59 @@ mfamily <- case maybeFont of Nothing -> do - putStrLn "No font installed?" + putStrLn "No fonts installed?" return Nothing Just font -> do notcovered <- filterM (fmap not . Pango.fontHasChar font) str - if null notcovered - then Pango.fontDescribe font >>= Pango.fontDescriptionGetFamily - else do + unless (null notcovered) $ putStrLn $ "no font coverage for" +-+ quoteStr notcovered ++ "!" - return Nothing + if notcovered == str + then return Nothing + else Pango.fontDescribe font >>= Pango.fontDescriptionGetFamily let hexStr = if hex then unwords $ map hexify str else "" - putStrLn $ - quoteStr str +-+ hexStr +-+ ":" +-+ maybe "Unknown" T.unpack mfamily - when unicode $ + case mfamily of + Just family -> + putStrLn $ quoteStr str +-+ hexStr +-+ ":" +-+ T.unpack family + Nothing -> + unless (null hexStr) $ + putStrLn $ quoteStr str +-+ hexStr + + when (unicode || isNothing mfamily) $ forM_ str $ \char -> do putChar char let mname = UN.name char script = US.script char codepoint = printf "U+%04X" (ord char) - putStrLn $ " <" ++ codepoint ++ ">:" +-+ fromMaybe "unknown codepoint" mname +-+ '[' : show script ++ "]" -- +-+ '(' : US.scriptShortName script ++ ")" + putStrLn $ " <" ++ codepoint ++ ">:" +-+ fromMaybe "unknown codepoint" mname +-+ '[' : show script ++ "]" -- +-+ parenStr (US.scriptShortName script) where hexify :: Char -> String hexify char = let bytes = TE.encodeUtf8 $ T.singleton char in '[' : unwords [printf "%02x" b | b <- B.unpack bytes] ++ "]" + +-- generated by orth/orth.hs +orths :: [String] +orths = + ["aa","ab","af","agr","ak","am","an","anp","ar","as","ast","av","ay","ayc","az-az","az-ir","ba","be","bem","ber-dz","ber-ma","bg","bh","bhb","bho","bi","bin","bm","bn","bo","br","brx","bs","bua","byn","ca","ce","ch","chm","chr","ckb","cmn","co","cop","crh","cs","csb","cu","cv","cy","da","de","doi","dsb","dv","dz","ee","el","en","eo","es","et","eu","fa","fat","ff","fi","fil","fj","fo","fr","fur","fy","ga","gd","gez","gl","gn","got","gu","gv","ha","hak","haw","he","hi","hif","hne","ho","hr","hsb","ht","hu","hy","hz","ia","id","ie","ig","ii","ik","io","is","it","iu","ja","jv","ka","kaa","kab","ki","kj","kk","kl","km","kn","ko","kok","kr","ks","ku-am","ku-iq","ku-ir","ku-tr","kum","kv","kw","kwm","ky","la","lah","lb","lez","lg","li","lij","ln","lo","lt","lv","lzh","mag","mai","mfe","mg","mh","mhr","mi","miq","mjw","mk","ml","mn-cn","mn-mn","mni","mnw","mo","mr","ms","mt","my","na","nan","nb","nds","ne","ng","nhn","niu","nl","nn","no","nqo","nr","nso","nv","ny","oc","om","or","os","ota","pa","pa-pk","pap-an","pap-aw","pes","pl","prs","ps-af","ps-pk","pt","qu","quz","raj","rif","rm","rn","ro","ru","rw","sa","sah","sat","sc","sco","sd","se","sel","sg","sgs","sh","shn","shs","si","sid","sk","sl","sm","sma","smj","smn","sms","sn","so","sq","sr","ss","st","su","sv","sw","syr","szl","ta","tcy","te","tg","th","the","ti-er","ti-et","tig","tk","tl","tn","to","tpi","tr","ts","tt","tw","ty","tyv","ug","uk","und-zmth","und-zsye","unm","ur","uz","ve","vi","vo","vot","wa","wae","wal","wen","wo","xh","yap","yi","yo","yue","yuw","za","zh-cn","zh-hk","zh-mo","zh-sg","zh-tw","zu"] + +determineLangCode :: String -> IO (Pango.Language, String) +determineLangCode lang = do + mplang <- Pango.languageFromString $ Just $ T.pack lang + (plang,code) <- + case mplang of + Nothing -> error' "impossible happened: no Pango lang from string" + Just l -> do + lc <- T.unpack <$> Pango.languageToString l + return (l,lc) + if code `notElem` orths + then + if any (`elem` code) "-@" + then determineLangCode $ takeWhile isAsciiLower code + else do + putStrLn $ "Unknown fontconfig langcode:" +-+ quoteStr code + return (plang,code) + else return (plang,code)