Define how many tags to see in ui settings

modules/webapp/src/main/elm/Comp/FolderSelect.elm

@@ -10,6 +10,7 @@ import Api.Model.FolderItem exposing (FolderItem)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onClick)
+import Util.ExpandCollapse
 import Util.List
 
 
@@ -103,44 +104,18 @@ renderItems constr model =
 
 expandToggle : Int -> Model -> List (Html Msg)
 expandToggle max model =
-    if max > List.length model.all then
+    Util.ExpandCollapse.expandToggle
-        []
+        max
-
+        (List.length model.all)
-    else
+        ToggleExpand
-        [ a
-            [ class "item"
-            , onClick ToggleExpand
-            , href "#"
-            ]
-            [ i [ class "angle down icon" ] []
-            , div [ class "content" ]
-                [ div [ class "description" ]
-                    [ em [] [ text "Show More …" ]
-                    ]
-                ]
-            ]
-        ]
 
 
 collapseToggle : Int -> Model -> List (Html Msg)
 collapseToggle max model =
-    if max > List.length model.all then
+    Util.ExpandCollapse.collapseToggle
-        []
+        max
-
+        (List.length model.all)
-    else
+        ToggleExpand
-        [ a
-            [ class "item"
-            , onClick ToggleExpand
-            , href "#"
-            ]
-            [ i [ class "angle up icon" ] []
-            , div [ class "content" ]
-                [ div [ class "description" ]
-                    [ em [] [ text "Show Less …" ]
-                    ]
-                ]
-            ]
-        ]
 
 
 viewItem : Model -> FolderItem -> Html Msg

modules/webapp/src/main/elm/Comp/SearchMenu.elm

@@ -555,175 +555,182 @@ view : Flags -> UiSettings -> Model -> Html Msg
 view flags settings model =
     let
         formHeader icon headline =
-            div [ class "ui small dividing header" ]
+            div [ class "ui tiny header" ]
                 [ icon
                 , div [ class "content" ]
                     [ text headline
                     ]
                 ]
 
-        formHeaderHelp icon headline tagger =
+        segmentClass =
-            div [ class "ui small dividing header" ]
+            "ui vertical segment"
-                [ a
-                    [ class "right-float"
-                    , href "#"
-                    , onClick tagger
-                    ]
-                    [ i [ class "small grey help link icon" ] []
-                    ]
-                , icon
-                , div [ class "content" ]
-                    [ text headline
-                    ]
-                ]
-
-        nameIcon =
-            i [ class "left align icon" ] []
     in
     div [ class "ui form" ]
-        [ div [ class "inline field" ]
+        [ div [ class segmentClass ]
-            [ div [ class "ui checkbox" ]
+            [ div [ class "inline field" ]
-                [ input
+                [ div [ class "ui checkbox" ]
-                    [ type_ "checkbox"
+                    [ input
-                    , onCheck (\_ -> ToggleInbox)
+                        [ type_ "checkbox"
-                    , checked model.inboxCheckbox
+                        , onCheck (\_ -> ToggleInbox)
+                        , checked model.inboxCheckbox
+                        ]
+                        []
+                    , label []
+                        [ text "Only New"
+                        ]
+                    ]
+                ]
+            ]
+        , div [ class segmentClass ]
+            [ Html.map TagSelectMsg (Comp.TagSelect.viewTags settings model.tagSelectModel)
+            , Html.map TagSelectMsg (Comp.TagSelect.viewCats settings model.tagSelectModel)
+            , Html.map FolderSelectMsg
+                (Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList)
+            ]
+        , div [ class segmentClass ]
+            [ formHeader (Icons.correspondentIcon "")
+                (case getDirection model of
+                    Just Data.Direction.Incoming ->
+                        "Sender"
+
+                    Just Data.Direction.Outgoing ->
+                        "Recipient"
+
+                    Nothing ->
+                        "Correspondent"
+                )
+            , div [ class "field" ]
+                [ label [] [ text "Organization" ]
+                , Html.map OrgMsg (Comp.Dropdown.view settings model.orgModel)
+                ]
+            , div [ class "field" ]
+                [ label [] [ text "Person" ]
+                , Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel)
+                ]
+            , formHeader Icons.concernedIcon "Concerned"
+            , div [ class "field" ]
+                [ label [] [ text "Person" ]
+                , Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel)
+                ]
+            , div [ class "field" ]
+                [ label [] [ text "Equipment" ]
+                , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel)
+                ]
+            ]
+        , div [ class segmentClass ]
+            [ formHeader (Icons.searchIcon "") "Text Search"
+            , div
+                [ classList
+                    [ ( "field", True )
+                    , ( "invisible hidden", not flags.config.fullTextSearchEnabled )
+                    ]
+                ]
+                [ label [] [ text "Fulltext Search" ]
+                , input
+                    [ type_ "text"
+                    , onInput SetFulltext
+                    , Util.Html.onKeyUpCode KeyUpMsg
+                    , model.fulltextModel |> Maybe.withDefault "" |> value
+                    , placeholder "Fulltext search in results…"
                     ]
                     []
-                , label []
+                , span [ class "small-info" ]
-                    [ text "Only New"
+                    [ text "Fulltext search in document contents and notes."
                     ]
                 ]
-            ]
-        , Html.map TagSelectMsg (Comp.TagSelect.view settings model.tagSelectModel)
-        , Html.map FolderSelectMsg
-            (Comp.FolderSelect.view settings.searchMenuFolderCount model.folderList)
-        , formHeaderHelp nameIcon "Names" ToggleNameHelp
-        , span
-            [ classList
-                [ ( "small-info", True )
-                , ( "invisible hidden", not model.showNameHelp )
-                ]
-            ]
-            [ text "Use wildcards "
-            , code [] [ text "*" ]
-            , text " at beginning or end. Added automatically if not "
-            , text "present and not quoted. Press "
-            , em [] [ text "Enter" ]
-            , text " to start searching."
-            ]
-        , div [ class "field" ]
-            [ input
-                [ type_ "text"
-                , onInput SetAllName
-                , Util.Html.onKeyUpCode KeyUpMsg
-                , model.allNameModel |> Maybe.withDefault "" |> value
-                , placeholder "Search in various names…"
-                ]
-                []
-            , span
-                [ classList
-                    [ ( "small-info", True )
-                    , ( "invisible hidden", not model.showNameHelp )
-                    ]
-                ]
-                [ text "Looks in correspondents, concerned entities, item name and notes."
-                ]
-            ]
-        , formHeader (Icons.correspondentIcon "")
-            (case getDirection model of
-                Just Data.Direction.Incoming ->
-                    "Sender"
-
-                Just Data.Direction.Outgoing ->
-                    "Recipient"
-
-                Nothing ->
-                    "Correspondent"
-            )
-        , div [ class "field" ]
-            [ label [] [ text "Organization" ]
-            , Html.map OrgMsg (Comp.Dropdown.view settings model.orgModel)
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Person" ]
-            , Html.map CorrPersonMsg (Comp.Dropdown.view settings model.corrPersonModel)
-            ]
-        , formHeader Icons.concernedIcon "Concerned"
-        , div [ class "field" ]
-            [ label [] [ text "Person" ]
-            , Html.map ConcPersonMsg (Comp.Dropdown.view settings model.concPersonModel)
-            ]
-        , div [ class "field" ]
-            [ label [] [ text "Equipment" ]
-            , Html.map ConcEquipmentMsg (Comp.Dropdown.view settings model.concEquipmentModel)
-            ]
-        , formHeader (Icons.searchIcon "") "Content"
-        , div
-            [ classList
-                [ ( "field", True )
-                , ( "invisible hidden", not flags.config.fullTextSearchEnabled )
-                ]
-            ]
-            [ input
-                [ type_ "text"
-                , onInput SetFulltext
-                , Util.Html.onKeyUpCode KeyUpMsg
-                , model.fulltextModel |> Maybe.withDefault "" |> value
-                , placeholder "Fulltext search in results…"
-                ]
-                []
-            , span [ class "small-info" ]
-                [ text "Fulltext search in document contents and notes."
-                ]
-            ]
-        , formHeader (Icons.dateIcon "") "Date"
-        , div [ class "fields" ]
-            [ div [ class "field" ]
-                [ label []
-                    [ text "From"
-                    ]
-                , Html.map FromDateMsg
-                    (Comp.DatePicker.viewTimeDefault
-                        model.fromDate
-                        model.fromDateModel
-                    )
-                ]
             , div [ class "field" ]
                 [ label []
-                    [ text "To"
+                    [ text "Names"
+                    , a
+                        [ class "right-float"
+                        , href "#"
+                        , onClick ToggleNameHelp
+                        ]
+                        [ i [ class "small grey help link icon" ] []
+                        ]
+                    ]
+                , input
+                    [ type_ "text"
+                    , onInput SetAllName
+                    , Util.Html.onKeyUpCode KeyUpMsg
+                    , model.allNameModel |> Maybe.withDefault "" |> value
+                    , placeholder "Search in various names…"
+                    ]
+                    []
+                , span
+                    [ classList
+                        [ ( "small-info", True )
+                        ]
+                    ]
+                    [ text "Looks in correspondents, concerned entities, item name and notes."
+                    ]
+                , p
+                    [ classList
+                        [ ( "small-info", True )
+                        , ( "invisible hidden", not model.showNameHelp )
+                        ]
+                    ]
+                    [ text "Use wildcards "
+                    , code [] [ text "*" ]
+                    , text " at beginning or end. They are added automatically on both sides "
+                    , text "if not present in the search term and the term is not quoted. Press "
+                    , em [] [ text "Enter" ]
+                    , text " to start searching."
                     ]
-                , Html.map UntilDateMsg
-                    (Comp.DatePicker.viewTimeDefault
-                        model.untilDate
-                        model.untilDateModel
-                    )
                 ]
             ]
-        , formHeader (Icons.dueDateIcon "") "Due Date"
+        , div [ class segmentClass ]
-        , div [ class "fields" ]
+            [ formHeader (Icons.dateIcon "") "Date"
-            [ div [ class "field" ]
+            , div [ class "fields" ]
-                [ label []
+                [ div [ class "field" ]
-                    [ text "Due From"
+                    [ label []
+                        [ text "From"
+                        ]
+                    , Html.map FromDateMsg
+                        (Comp.DatePicker.viewTimeDefault
+                            model.fromDate
+                            model.fromDateModel
+                        )
+                    ]
+                , div [ class "field" ]
+                    [ label []
+                        [ text "To"
+                        ]
+                    , Html.map UntilDateMsg
+                        (Comp.DatePicker.viewTimeDefault
+                            model.untilDate
+                            model.untilDateModel
+                        )
                     ]
-                , Html.map FromDueDateMsg
-                    (Comp.DatePicker.viewTimeDefault
-                        model.fromDueDate
-                        model.fromDueDateModel
-                    )
                 ]
+            , formHeader (Icons.dueDateIcon "") "Due Date"
+            , div [ class "fields" ]
+                [ div [ class "field" ]
+                    [ label []
+                        [ text "Due From"
+                        ]
+                    , Html.map FromDueDateMsg
+                        (Comp.DatePicker.viewTimeDefault
+                            model.fromDueDate
+                            model.fromDueDateModel
+                        )
+                    ]
+                , div [ class "field" ]
+                    [ label []
+                        [ text "Due To"
+                        ]
+                    , Html.map UntilDueDateMsg
+                        (Comp.DatePicker.viewTimeDefault
+                            model.untilDueDate
+                            model.untilDueDateModel
+                        )
+                    ]
+                ]
+            ]
+        , div [ class segmentClass ]
+            [ formHeader (Icons.directionIcon "") "Direction"
             , div [ class "field" ]
-                [ label []
+                [ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
-                    [ text "Due To"
-                    ]
-                , Html.map UntilDueDateMsg
-                    (Comp.DatePicker.viewTimeDefault
-                        model.untilDueDate
-                        model.untilDueDateModel
-                    )
                 ]
             ]
-        , formHeader (Icons.directionIcon "") "Direction"
-        , div [ class "field" ]
-            [ Html.map DirectionMsg (Comp.Dropdown.view settings model.directionModel)
-            ]
         ]

modules/webapp/src/main/elm/Comp/TagSelect.elm

@@ -6,7 +6,10 @@ module Comp.TagSelect exposing
     , emptySelection
     , init
     , update
-    , view
+    , view1
+    , view2
+    , viewCats
+    , viewTags
     )
 
 import Api.Model.TagCount exposing (TagCount)
@@ -16,6 +19,7 @@ import Dict exposing (Dict)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onClick)
+import Util.ExpandCollapse
 
 
 type alias Model =
@@ -206,8 +210,8 @@ catState model name =
             Deselect
 
 
-view : UiSettings -> Model -> Html Msg
+viewTags : UiSettings -> Model -> Html Msg
-view settings model =
+viewTags settings model =
     div [ class "ui list" ]
         [ div [ class "item" ]
             [ I.tagIcon ""
@@ -216,7 +220,39 @@ view settings model =
                     [ text "Tags"
                     ]
                 , div [ class "ui relaxed list" ]
-                    (List.map (viewTagItem settings model) model.all)
+                    (renderTagItems settings model)
+                ]
+            ]
+        ]
+
+
+viewCats : UiSettings -> Model -> Html Msg
+viewCats settings model =
+    div [ class "ui list" ]
+        [ div [ class "item" ]
+            [ I.tagsIcon ""
+            , div [ class "content" ]
+                [ div [ class "header" ]
+                    [ text "Categories"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderCatItems settings model)
+                ]
+            ]
+        ]
+
+
+view1 : UiSettings -> Model -> Html Msg
+view1 settings model =
+    div [ class "ui list" ]
+        [ div [ class "item" ]
+            [ I.tagIcon ""
+            , div [ class "content" ]
+                [ div [ class "header" ]
+                    [ text "Tags"
+                    ]
+                , div [ class "ui relaxed list" ]
+                    (renderTagItems settings model)
                 ]
             ]
         , div [ class "item" ]
@@ -226,12 +262,81 @@ view settings model =
                     [ text "Categories"
                     ]
                 , div [ class "ui relaxed list" ]
-                    (List.map (viewCategoryItem settings model) model.categories)
+                    (renderCatItems settings model)
                 ]
             ]
         ]
 
 
+view2 : UiSettings -> Model -> List (Html Msg)
+view2 settings model =
+    [ viewTags settings model
+    , viewCats settings model
+    ]
+
+
+renderTagItems : UiSettings -> Model -> List (Html Msg)
+renderTagItems settings model =
+    let
+        tags =
+            model.all
+
+        max =
+            settings.searchMenuTagCount
+
+        exp =
+            Util.ExpandCollapse.expandToggle
+                max
+                (List.length tags)
+                ToggleExpandTags
+
+        cps =
+            Util.ExpandCollapse.collapseToggle
+                max
+                (List.length tags)
+                ToggleExpandTags
+    in
+    if max <= 0 then
+        List.map (viewTagItem settings model) model.all
+
+    else if model.expandedTags then
+        List.map (viewTagItem settings model) model.all ++ cps
+
+    else
+        List.map (viewTagItem settings model) (List.take max model.all) ++ exp
+
+
+renderCatItems : UiSettings -> Model -> List (Html Msg)
+renderCatItems settings model =
+    let
+        cats =
+            model.categories
+
+        max =
+            settings.searchMenuTagCatCount
+
+        exp =
+            Util.ExpandCollapse.expandToggle
+                max
+                (List.length cats)
+                ToggleExpandCats
+
+        cps =
+            Util.ExpandCollapse.collapseToggle
+                max
+                (List.length cats)
+                ToggleExpandCats
+    in
+    if max <= 0 then
+        List.map (viewCategoryItem settings model) model.categories
+
+    else if model.expandedCats then
+        List.map (viewCategoryItem settings model) model.categories ++ cps
+
+    else
+        List.map (viewCategoryItem settings model) (List.take max model.categories) ++ exp
+
+
 viewCategoryItem : UiSettings -> Model -> Category -> Html Msg
 viewCategoryItem settings model cat =
     let

modules/webapp/src/main/elm/Comp/UiSettingsForm.elm

@@ -32,6 +32,10 @@ type alias Model =
     , itemDetailNotesPosition : Pos
     , searchMenuFolderCount : Maybe Int
     , searchMenuFolderCountModel : Comp.IntField.Model
+    , searchMenuTagCount : Maybe Int
+    , searchMenuTagCountModel : Comp.IntField.Model
+    , searchMenuTagCatCount : Maybe Int
+    , searchMenuTagCatCountModel : Comp.IntField.Model
     }
 
 
@@ -65,6 +69,20 @@ init flags settings =
                 (Just 2000)
                 False
                 "Number of folders in search menu"
+      , searchMenuTagCount = Just settings.searchMenuTagCount
+      , searchMenuTagCountModel =
+            Comp.IntField.init
+                (Just 0)
+                (Just 2000)
+                False
+                "Number of tags in search menu"
+      , searchMenuTagCatCount = Just settings.searchMenuTagCatCount
+      , searchMenuTagCatCountModel =
+            Comp.IntField.init
+                (Just 0)
+                (Just 2000)
+                False
+                "Number of categories in search menu"
       }
     , Api.getTags flags "" GetTagsResp
     )
@@ -78,6 +96,8 @@ type Msg
     | NoteLengthMsg Comp.IntField.Msg
     | SetNotesPosition Pos
     | SearchMenuFolderMsg Comp.IntField.Msg
+    | SearchMenuTagMsg Comp.IntField.Msg
+    | SearchMenuTagCatMsg Comp.IntField.Msg
 
 
 
@@ -135,6 +155,38 @@ update sett msg model =
             in
             ( model_, nextSettings )
 
+        SearchMenuTagMsg lm ->
+            let
+                ( m, n ) =
+                    Comp.IntField.update lm model.searchMenuTagCountModel
+
+                nextSettings =
+                    Maybe.map (\len -> { sett | searchMenuTagCount = len }) n
+
+                model_ =
+                    { model
+                        | searchMenuTagCountModel = m
+                        , searchMenuTagCount = n
+                    }
+            in
+            ( model_, nextSettings )
+
+        SearchMenuTagCatMsg lm ->
+            let
+                ( m, n ) =
+                    Comp.IntField.update lm model.searchMenuTagCatCountModel
+
+                nextSettings =
+                    Maybe.map (\len -> { sett | searchMenuTagCatCount = len }) n
+
+                model_ =
+                    { model
+                        | searchMenuTagCatCountModel = m
+                        , searchMenuTagCatCount = n
+                    }
+            in
+            ( model_, nextSettings )
+
         SetNotesPosition pos ->
             let
                 model_ =
@@ -232,9 +284,23 @@ view flags _ model =
             )
         , div [ class "ui dividing header" ]
             [ text "Search Menu" ]
+        , Html.map SearchMenuTagMsg
+            (Comp.IntField.viewWithInfo
+                "How many tags to display in search menu at once. Others can be expanded. Use 0 to always show all."
+                model.searchMenuTagCount
+                "field"
+                model.searchMenuTagCountModel
+            )
+        , Html.map SearchMenuTagCatMsg
+            (Comp.IntField.viewWithInfo
+                "How many categories to display in search menu at once. Others can be expanded. Use 0 to always show all."
+                model.searchMenuTagCatCount
+                "field"
+                model.searchMenuTagCatCountModel
+            )
         , Html.map SearchMenuFolderMsg
             (Comp.IntField.viewWithInfo
-                "How many folders to display in search menu at once. Other folders can be expanded."
+                "How many folders to display in search menu at once. Other folders can be expanded. Use 0 to always show all."
                 model.searchMenuFolderCount
                 "field"
                 model.searchMenuFolderCountModel

modules/webapp/src/main/elm/Data/UiSettings.elm

@@ -34,6 +34,8 @@ type alias StoredUiSettings =
     , itemSearchNoteLength : Maybe Int
     , itemDetailNotesPosition : Maybe String
     , searchMenuFolderCount : Maybe Int
+    , searchMenuTagCount : Maybe Int
+    , searchMenuTagCatCount : Maybe Int
     }
 
 
@@ -51,6 +53,8 @@ type alias UiSettings =
     , itemSearchNoteLength : Int
     , itemDetailNotesPosition : Pos
     , searchMenuFolderCount : Int
+    , searchMenuTagCount : Int
+    , searchMenuTagCatCount : Int
     }
 
 
@@ -89,7 +93,9 @@ defaults =
     , nativePdfPreview = False
     , itemSearchNoteLength = 0
     , itemDetailNotesPosition = Top
-    , searchMenuFolderCount = 4
+    , searchMenuFolderCount = 3
+    , searchMenuTagCount = 6
+    , searchMenuTagCatCount = 3
     }
 
 
@@ -114,6 +120,10 @@ merge given fallback =
     , searchMenuFolderCount =
         choose given.searchMenuFolderCount
             fallback.searchMenuFolderCount
+    , searchMenuTagCount =
+        choose given.searchMenuTagCount fallback.searchMenuTagCount
+    , searchMenuTagCatCount =
+        choose given.searchMenuTagCatCount fallback.searchMenuTagCatCount
     }
 
 
@@ -132,6 +142,8 @@ toStoredUiSettings settings =
     , itemSearchNoteLength = Just settings.itemSearchNoteLength
     , itemDetailNotesPosition = Just (posToString settings.itemDetailNotesPosition)
     , searchMenuFolderCount = Just settings.searchMenuFolderCount
+    , searchMenuTagCount = Just settings.searchMenuTagCount
+    , searchMenuTagCatCount = Just settings.searchMenuTagCatCount
     }
 
 

modules/webapp/src/main/elm/Util/ExpandCollapse.elm

@@ -0,0 +1,50 @@
+module Util.ExpandCollapse exposing
+    ( collapseToggle
+    , expandToggle
+    )
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+
+
+expandToggle : Int -> Int -> msg -> List (Html msg)
+expandToggle max all m =
+    if max >= all then
+        []
+
+    else
+        [ a
+            [ class "item"
+            , onClick m
+            , href "#"
+            ]
+            [ i [ class "angle down icon" ] []
+            , div [ class "content" ]
+                [ div [ class "description" ]
+                    [ em [] [ text "Show More …" ]
+                    ]
+                ]
+            ]
+        ]
+
+
+collapseToggle : Int -> Int -> msg -> List (Html msg)
+collapseToggle max all m =
+    if max >= all then
+        []
+
+    else
+        [ a
+            [ class "item"
+            , onClick m
+            , href "#"
+            ]
+            [ i [ class "angle up icon" ] []
+            , div [ class "content" ]
+                [ div [ class "description" ]
+                    [ em [] [ text "Show Less …" ]
+                    ]
+                ]
+            ]
+        ]